Changeset ff050cd in flexpart.git for src_parallel/readoutgrid.f90
- Timestamp:
- Aug 15, 2013, 3:23:48 PM (11 years ago)
- Branches:
- flexpart91_hasod
- Children:
- 31113de
- Parents:
- 7c1fd44
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
src_parallel/readoutgrid.f90
r3eed2e6 rff050cd 53 53 real,parameter :: eps=1.e-4 54 54 55 55 ! namelist variables 56 integer, parameter :: maxoutlev=500 57 real :: outheights(maxoutlev) 58 integer :: readerror 59 60 ! declare namelist 61 namelist /outgrid/ & 62 outlon0,outlat0, & 63 numxgrid,numygrid, & 64 dxout,dyout, & 65 outheights 66 67 ! helps identifying failed namelist input 68 dxout=-1.0 69 outheights=-1.0 56 70 57 71 ! Open the OUTGRID file and read output grid specifications … … 61 75 err=999) 62 76 63 64 call skplin(5,unitoutgrid) 65 66 67 ! 1. Read horizontal grid specifications 68 !**************************************** 69 70 call skplin(3,unitoutgrid) 71 read(unitoutgrid,'(4x,f11.4)') outlon0 72 call skplin(3,unitoutgrid) 73 read(unitoutgrid,'(4x,f11.4)') outlat0 74 call skplin(3,unitoutgrid) 75 read(unitoutgrid,'(4x,i5)') numxgrid 76 call skplin(3,unitoutgrid) 77 read(unitoutgrid,'(4x,i5)') numygrid 78 call skplin(3,unitoutgrid) 79 read(unitoutgrid,'(4x,f12.5)') dxout 80 call skplin(3,unitoutgrid) 81 read(unitoutgrid,'(4x,f12.5)') dyout 82 77 ! try namelist input 78 read(unitoutgrid,outgrid,iostat=readerror) 79 80 81 if ((dxout.le.0).or.(readerror.ne.0)) then 82 83 readerror=1 84 85 rewind(unitoutgrid) 86 call skplin(5,unitoutgrid) 87 88 ! 1. Read horizontal grid specifications 89 !**************************************** 90 91 call skplin(3,unitoutgrid) 92 read(unitoutgrid,'(4x,f11.4)') outlon0 93 call skplin(3,unitoutgrid) 94 read(unitoutgrid,'(4x,f11.4)') outlat0 95 call skplin(3,unitoutgrid) 96 read(unitoutgrid,'(4x,i5)') numxgrid 97 call skplin(3,unitoutgrid) 98 read(unitoutgrid,'(4x,i5)') numygrid 99 call skplin(3,unitoutgrid) 100 read(unitoutgrid,'(4x,f12.5)') dxout 101 call skplin(3,unitoutgrid) 102 read(unitoutgrid,'(4x,f12.5)') dyout 103 104 endif 83 105 84 106 ! Check validity of output grid (shall be within model domain) … … 102 124 ! 2. Count Vertical levels of output grid 103 125 !**************************************** 104 j=0 105 100 j=j+1 126 127 if (readerror.ne.0) then 128 j=0 129 100 j=j+1 106 130 do i=1,3 107 131 read(unitoutgrid,*,end=99) … … 110 134 if (outhelp.eq.0.) goto 99 111 135 goto 100 112 99 113 114 allocate(outheight(numzgrid) &115 ,stat=stat)116 if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'117 allocate(outheighthalf(numzgrid) &118 ,stat=stat)119 if (stat.ne.0) write(*,*)'ERROR: could not allocate outh' 120 121 122 rewind(unitoutgrid)123 call skplin(29,unitoutgrid)136 99 numzgrid=j-1 137 else 138 do i=1,maxoutlev 139 if (outheights(i).lt.0) exit 140 end do 141 numzgrid=i-1 142 end if 143 144 allocate(outheight(numzgrid),stat=stat) 145 if (stat.ne.0) write(*,*)'ERROR: could not allocate outheight' 146 allocate(outheighthalf(numzgrid),stat=stat) 147 if (stat.ne.0) write(*,*)'ERROR: could not allocate outheighthalf' 124 148 125 149 ! 2. Vertical levels of output grid 126 150 !********************************** 127 151 128 j=0 129 1000 j=j+1 130 do i=1,3 131 read(unitoutgrid,*,end=990) 132 end do 133 read(unitoutgrid,'(4x,f7.1)',end=990) outhelp 134 if (outhelp.eq.0.) goto 99 135 outheight(j)=outhelp 136 goto 1000 137 990 numzgrid=j-1 138 152 if (readerror.ne.0) then 153 154 rewind(unitoutgrid) 155 call skplin(29,unitoutgrid) 156 157 do j=1,numzgrid 158 do i=1,3 159 read(unitoutgrid,*) 160 end do 161 read(unitoutgrid,'(4x,f7.1)') outhelp 162 outheight(j)=outhelp 163 end do 164 165 else 166 167 do j=1,numzgrid 168 outheight(j)=outheights(j) 169 end do 170 171 endif 172 173 close(unitoutgrid) 139 174 140 175 ! Check whether vertical levels are specified in ascending order … … 158 193 end do 159 194 160 161 195 xoutshift=xlon0-outlon0 162 196 youtshift=ylat0-outlat0 163 close(unitoutgrid) 164 165 allocate(oroout(0:numxgrid-1,0:numygrid-1) & 166 ,stat=stat) 167 if (stat.ne.0) write(*,*)'ERROR: could not allocate outh' 168 allocate(area(0:numxgrid-1,0:numygrid-1) & 169 ,stat=stat) 170 if (stat.ne.0) write(*,*)'ERROR: could not allocate outh' 171 allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid) & 172 ,stat=stat) 173 if (stat.ne.0) write(*,*)'ERROR: could not allocate outh' 174 allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid) & 175 ,stat=stat) 176 if (stat.ne.0) write(*,*)'ERROR: could not allocate outh' 177 allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid) & 178 ,stat=stat) 179 if (stat.ne.0) write(*,*)'ERROR: could not allocate outh' 197 198 allocate(oroout(0:numxgrid-1,0:numygrid-1),stat=stat) 199 if (stat.ne.0) write(*,*)'ERROR: could not allocate oroout' 200 allocate(area(0:numxgrid-1,0:numygrid-1),stat=stat) 201 if (stat.ne.0) write(*,*)'ERROR: could not allocate area' 202 allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat) 203 if (stat.ne.0) write(*,*)'ERROR: could not allocate volume' 204 allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat) 205 if (stat.ne.0) write(*,*)'ERROR: could not allocate areaeast' 206 allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat) 207 if (stat.ne.0) write(*,*)'ERROR: could not allocate areanorth' 180 208 return 181 209 182 210 183 999 211 999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID" #### ' 184 212 write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY #### ' 185 213 write(*,*) ' #### xxx/flexpart/options #### '
Note: See TracChangeset
for help on using the changeset viewer.