Initial checkin of 5.0
Alastair McKinstry
10 years ago
| 0 | program flextra | |
| 1 | ******************************************************************************** | |
| 2 | * * | |
| 3 | * This program calculates trajectories for various input wind fields. * | |
| 4 | * * | |
| 5 | * Authors: A. Stohl, G. Wotawa * | |
| 6 | * * | |
| 7 | * 2 February 1994 * | |
| 8 | * * | |
| 9 | * Update: January 1999: A. Stohl * | |
| 10 | * Use of global fields, CET option, etc. * | |
| 11 | * * | |
| 12 | ******************************************************************************** | |
| 13 | * * | |
| 14 | * Variables: * | |
| 15 | * error .true., if error ocurred in subprogram, else .false. * | |
| 16 | * * | |
| 17 | * Constants: * | |
| 18 | * * | |
| 19 | ******************************************************************************** | |
| 20 | ||
| 21 | include 'includepar' | |
| 22 | include 'includecom' | |
| 23 | ||
| 24 | logical error,oronew | |
| 25 | ||
| 26 | ||
| 27 | C Read the pathnames where input/output files are stored | |
| 28 | ******************************************************** | |
| 29 | ||
| 30 | call readpaths(error) | |
| 31 | if (error) goto 999 | |
| 32 | ||
| 33 | ||
| 34 | C Read the user specifications for the current model run | |
| 35 | ******************************************************** | |
| 36 | ||
| 37 | call readcommand(error) | |
| 38 | if (error) goto 999 | |
| 39 | ||
| 40 | C Read, which wind fields are available within the modelling period | |
| 41 | ******************************************************************* | |
| 42 | ||
| 43 | call readavailable(error) | |
| 44 | if(error) goto 999 | |
| 45 | ||
| 46 | C Determine the grid specifications and the vertical discretization | |
| 47 | ******************************************************************* | |
| 48 | ||
| 49 | call gridcheck(oronew,error) | |
| 50 | if(error) goto 999 | |
| 51 | call gridcheck_nests(error) | |
| 52 | if(error) goto 999 | |
| 53 | ||
| 54 | ||
| 55 | C Read the orography used by the ECMWF model | |
| 56 | ******************************************** | |
| 57 | ||
| 58 | if(.not.oronew) call readoro(error) | |
| 59 | if(error) goto 999 | |
| 60 | ||
| 61 | C Read the coordinates of trajectory beginning/ending points for the | |
| 62 | C current model run | |
| 63 | C Alternatively, if CET is to be calculated read CET starting domain | |
| 64 | ******************************************************************** | |
| 65 | ||
| 66 | if (modecet.eq.1) then | |
| 67 | call readpoints(error) | |
| 68 | else if (modecet.eq.2) then | |
| 69 | call readcet(error) | |
| 70 | else | |
| 71 | call readflight(error) | |
| 72 | endif | |
| 73 | if(error) goto 999 | |
| 74 | ||
| 75 | ||
| 76 | C Check, if user selected options don't exceed the current dimension limits | |
| 77 | *************************************************************************** | |
| 78 | ||
| 79 | call checklimits(error) | |
| 80 | if(error) goto 999 | |
| 81 | ||
| 82 | C Conversion of the startpoints from geografical to grid coordinates | |
| 83 | ******************************************************************** | |
| 84 | ||
| 85 | call coordtrafo(error) | |
| 86 | if(error) goto 999 | |
| 87 | ||
| 88 | ||
| 89 | C Fix the coordinates of the uncertainty trajectories | |
| 90 | ***************************************************** | |
| 91 | ||
| 92 | if (modecet.eq.1) call uncertcoor() | |
| 93 | ||
| 94 | ||
| 95 | C Subtract the orography from the height above sea level | |
| 96 | ******************************************************** | |
| 97 | ||
| 98 | call subtractoro() | |
| 99 | ||
| 100 | ||
| 101 | C Open the output files | |
| 102 | *********************** | |
| 103 | ||
| 104 | if (modecet.eq.1) then | |
| 105 | call openoutput(error) | |
| 106 | else if (modecet.eq.2) then | |
| 107 | call opencetoutput(error) | |
| 108 | else | |
| 109 | call openflightoutput(error) | |
| 110 | endif | |
| 111 | if(error) goto 999 | |
| 112 | ||
| 113 | ||
| 114 | C Calculate trajectories | |
| 115 | ************************ | |
| 116 | ||
| 117 | call timemanager() | |
| 118 | ||
| 119 | ||
| 120 | C Close output and reverse direction of back trajectory output | |
| 121 | ************************************************************** | |
| 122 | ||
| 123 | if (modecet.eq.1) call lastprocessor() | |
| 124 | ||
| 125 | write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FL | |
| 126 | +EXTRA MODEL RUN!' | |
| 127 | ||
| 128 | goto 1000 | |
| 129 | ||
| 130 | 999 write(*,*) 'FLEXTRA MODEL ERROR: EXECUTION HAD TO BE TERMINATED' | |
| 131 | ||
| 132 | 1000 continue | |
| 133 | ||
| 134 | end |
| 0 | subroutine calcpv(n) | |
| 1 | C | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * Calculation of potential vorticity on 3-d grid. * | |
| 5 | * * | |
| 6 | * Author: P. James * | |
| 7 | * 3 February 2000 * | |
| 8 | * * | |
| 9 | ******************************************************************************** | |
| 10 | * * | |
| 11 | * Variables: * | |
| 12 | * n temporal index for meteorological fields (1 to 3) * | |
| 13 | * * | |
| 14 | * Constants: * | |
| 15 | * * | |
| 16 | ******************************************************************************** | |
| 17 | ||
| 18 | include 'includepar' | |
| 19 | include 'includecom' | |
| 20 | ||
| 21 | integer n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch | |
| 22 | integer jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr | |
| 23 | integer nlck | |
| 24 | real vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f | |
| 25 | real theta,thetap,thetam,dthetadp,dt1,dt2,dt,ppmk | |
| 26 | real height(nuvzmax),pvavr,ppml(nuvzmax) | |
| 27 | real thup,thdn | |
| 28 | ||
| 29 | C Set number of levels to check for adjacent theta | |
| 30 | nlck=nuvz/3 | |
| 31 | do 5 k=1,nuvz | |
| 32 | height(k)=akz(k)/p0+bkz(k) | |
| 33 | 5 continue | |
| 34 | C *** Precalculate all theta levels for efficiency | |
| 35 | do 9 jy=0,ny-1 | |
| 36 | do 14 kl=1,nuvz | |
| 37 | do 13 ix=0,nx-1 | |
| 38 | ppmk=akz(kl)+bkz(kl)*ps(ix,jy,1,n) | |
| 39 | th(ix,jy,kl,n)=tt(ix,jy,kl,n)*(100000./ppmk)**kappa | |
| 40 | 13 continue | |
| 41 | 14 continue | |
| 42 | 9 continue | |
| 43 | C | |
| 44 | C Loop over entire grid | |
| 45 | *********************** | |
| 46 | do 10 jy=0,ny-1 | |
| 47 | if (sglobal.and.jy.eq.0) goto 10 | |
| 48 | if (nglobal.and.jy.eq.ny-1) goto 10 | |
| 49 | phi = (ylat0 + jy * dy) * pi / 180. | |
| 50 | f = 0.00014585 * sin(phi) | |
| 51 | tanphi = tan(phi) | |
| 52 | cosphi = cos(phi) | |
| 53 | C Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat) | |
| 54 | jyvp=jy+1 | |
| 55 | jyvm=jy-1 | |
| 56 | if (jy.eq.0) jyvm=0 | |
| 57 | if (jy.eq.ny-1) jyvp=ny-1 | |
| 58 | C Define absolute gap length | |
| 59 | jumpy=2 | |
| 60 | if (jy.eq.0.or.jy.eq.ny-1) jumpy=1 | |
| 61 | if (sglobal.and.jy.eq.1) then | |
| 62 | jyvm=1 | |
| 63 | jumpy=1 | |
| 64 | end if | |
| 65 | if (nglobal.and.jy.eq.ny-2) then | |
| 66 | jyvp=ny-2 | |
| 67 | jumpy=1 | |
| 68 | end if | |
| 69 | juy=jumpy | |
| 70 | C | |
| 71 | do 11 ix=0,nx-1 | |
| 72 | C Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long) | |
| 73 | ixvp=ix+1 | |
| 74 | ixvm=ix-1 | |
| 75 | jumpx=2 | |
| 76 | if (xglobal) then | |
| 77 | ivrp=ixvp | |
| 78 | ivrm=ixvm | |
| 79 | if (ixvm.lt.0) ivrm=ixvm+nx-1 | |
| 80 | if (ixvp.ge.nx) ivrp=ixvp-nx+1 | |
| 81 | else | |
| 82 | if (ix.eq.0) ixvm=0 | |
| 83 | if (ix.eq.nx-1) ixvp=nx-1 | |
| 84 | ivrp=ixvp | |
| 85 | ivrm=ixvm | |
| 86 | C Define absolute gap length | |
| 87 | if (ix.eq.0.or.ix.eq.nx-1) jumpx=1 | |
| 88 | end if | |
| 89 | jux=jumpx | |
| 90 | C Precalculate pressure values for efficiency | |
| 91 | do 8 kl=1,nuvz | |
| 92 | ppml(kl)=akz(kl)+bkz(kl)*ps(ix,jy,1,n) | |
| 93 | 8 continue | |
| 94 | C | |
| 95 | C Loop over the vertical | |
| 96 | ************************ | |
| 97 | ||
| 98 | do 12 kl=1,nuvz | |
| 99 | theta=th(ix,jy,kl,n) | |
| 100 | klvrp=kl+1 | |
| 101 | klvrm=kl-1 | |
| 102 | klpt=kl | |
| 103 | C If top or bottom level, dthetadp is evaluated between the current | |
| 104 | C level and the level inside, otherwise between level+1 and level-1 | |
| 105 | C | |
| 106 | if (klvrp.gt.nuvz) klvrp=nuvz | |
| 107 | if (klvrm.lt.1) klvrm=1 | |
| 108 | thetap=th(ix,jy,klvrp,n) | |
| 109 | thetam=th(ix,jy,klvrm,n) | |
| 110 | dthetadp=(thetap-thetam)/(ppml(klvrp)-ppml(klvrm)) | |
| 111 | ||
| 112 | C Compute vertical position at pot. temperature surface on subgrid | |
| 113 | C and the wind at that position | |
| 114 | ****************************************************************** | |
| 115 | C a) in x direction | |
| 116 | ii=0 | |
| 117 | do 20 i=ixvm,ixvp,jumpx | |
| 118 | ivr=i | |
| 119 | if (xglobal) then | |
| 120 | if (i.lt.0) ivr=ivr+nx-1 | |
| 121 | if (i.ge.nx) ivr=ivr-nx+1 | |
| 122 | end if | |
| 123 | ii=ii+1 | |
| 124 | C Search adjacent levels for current theta value | |
| 125 | C Spiral out from current level for efficiency | |
| 126 | kup=klpt-1 | |
| 127 | kdn=klpt | |
| 128 | kch=0 | |
| 129 | 40 continue | |
| 130 | C Upward branch | |
| 131 | kup=kup+1 | |
| 132 | if (kch.ge.nlck) goto 21 ! No more levels to check, | |
| 133 | C ! and no values found | |
| 134 | if (kup.ge.nuvz) goto 41 | |
| 135 | kch=kch+1 | |
| 136 | k=kup | |
| 137 | thdn=th(ivr,jy,k,n) | |
| 138 | thup=th(ivr,jy,k+1,n) | |
| 139 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 140 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 141 | dt1=abs(theta-thdn) | |
| 142 | dt2=abs(theta-thup) | |
| 143 | dt=dt1+dt2 | |
| 144 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 145 | dt1=0.5 ! G.W., 10.4.1996 | |
| 146 | dt2=0.5 | |
| 147 | dt=1.0 | |
| 148 | endif | |
| 149 | vx(ii)=(vv(ivr,jy,k,n)*dt2+vv(ivr,jy,k+1,n)*dt1)/dt | |
| 150 | goto 20 | |
| 151 | endif | |
| 152 | 41 continue | |
| 153 | C Downward branch | |
| 154 | kdn=kdn-1 | |
| 155 | if (kdn.lt.1) goto 40 | |
| 156 | kch=kch+1 | |
| 157 | k=kdn | |
| 158 | thdn=th(ivr,jy,k,n) | |
| 159 | thup=th(ivr,jy,k+1,n) | |
| 160 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 161 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 162 | dt1=abs(theta-thdn) | |
| 163 | dt2=abs(theta-thup) | |
| 164 | dt=dt1+dt2 | |
| 165 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 166 | dt1=0.5 ! G.W., 10.4.1996 | |
| 167 | dt2=0.5 | |
| 168 | dt=1.0 | |
| 169 | endif | |
| 170 | vx(ii)=(vv(ivr,jy,k,n)*dt2+vv(ivr,jy,k+1,n)*dt1)/dt | |
| 171 | goto 20 | |
| 172 | endif | |
| 173 | goto 40 | |
| 174 | C This section used when no values were found | |
| 175 | 21 continue | |
| 176 | C Must use vv at current level and long. jux becomes smaller by 1 | |
| 177 | vx(ii)=vv(ix,jy,kl,n) | |
| 178 | jux=jux-1 | |
| 179 | C Otherwise OK | |
| 180 | 20 continue | |
| 181 | if (jux.gt.0) then | |
| 182 | dvdx=(vx(2)-vx(1))/float(jux)/(dx*pi/180.) | |
| 183 | else | |
| 184 | dvdx=vv(ivrp,jy,kl,n)-vv(ivrm,jy,kl,n) | |
| 185 | dvdx=dvdx/float(jumpx)/(dx*pi/180.) | |
| 186 | C Only happens if no equivalent theta value | |
| 187 | C can be found on either side, hence must use values | |
| 188 | C from either side, same pressure level. | |
| 189 | end if | |
| 190 | ||
| 191 | C b) in y direction | |
| 192 | ||
| 193 | jj=0 | |
| 194 | do 50 j=jyvm,jyvp,jumpy | |
| 195 | jj=jj+1 | |
| 196 | C Search adjacent levels for current theta value | |
| 197 | C Spiral out from current level for efficiency | |
| 198 | kup=klpt-1 | |
| 199 | kdn=klpt | |
| 200 | kch=0 | |
| 201 | 70 continue | |
| 202 | C Upward branch | |
| 203 | kup=kup+1 | |
| 204 | if (kch.ge.nlck) goto 51 ! No more levels to check, | |
| 205 | C ! and no values found | |
| 206 | if (kup.ge.nuvz) goto 71 | |
| 207 | kch=kch+1 | |
| 208 | k=kup | |
| 209 | thdn=th(ix,j,k,n) | |
| 210 | thup=th(ix,j,k+1,n) | |
| 211 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 212 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 213 | dt1=abs(theta-thdn) | |
| 214 | dt2=abs(theta-thup) | |
| 215 | dt=dt1+dt2 | |
| 216 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 217 | dt1=0.5 ! G.W., 10.4.1996 | |
| 218 | dt2=0.5 | |
| 219 | dt=1.0 | |
| 220 | endif | |
| 221 | uy(jj)=(uu(ix,j,k,n)*dt2+uu(ix,j,k+1,n)*dt1)/dt | |
| 222 | goto 50 | |
| 223 | endif | |
| 224 | 71 continue | |
| 225 | C Downward branch | |
| 226 | kdn=kdn-1 | |
| 227 | if (kdn.lt.1) goto 70 | |
| 228 | kch=kch+1 | |
| 229 | k=kdn | |
| 230 | thdn=th(ix,j,k,n) | |
| 231 | thup=th(ix,j,k+1,n) | |
| 232 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 233 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 234 | dt1=abs(theta-thdn) | |
| 235 | dt2=abs(theta-thup) | |
| 236 | dt=dt1+dt2 | |
| 237 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 238 | dt1=0.5 ! G.W., 10.4.1996 | |
| 239 | dt2=0.5 | |
| 240 | dt=1.0 | |
| 241 | endif | |
| 242 | uy(jj)=(uu(ix,j,k,n)*dt2+uu(ix,j,k+1,n)*dt1)/dt | |
| 243 | goto 50 | |
| 244 | endif | |
| 245 | goto 70 | |
| 246 | C This section used when no values were found | |
| 247 | 51 continue | |
| 248 | C Must use uu at current level and lat. juy becomes smaller by 1 | |
| 249 | uy(jj)=uu(ix,jy,kl,n) | |
| 250 | juy=juy-1 | |
| 251 | C Otherwise OK | |
| 252 | 50 continue | |
| 253 | if (juy.gt.0) then | |
| 254 | dudy=(uy(2)-uy(1))/float(juy)/(dy*pi/180.) | |
| 255 | else | |
| 256 | dudy=uu(ix,jyvp,kl,n)-uu(ix,jyvm,kl,n) | |
| 257 | dudy=dudy/float(jumpy)/(dy*pi/180.) | |
| 258 | end if | |
| 259 | C | |
| 260 | pv(ix,jy,kl,n)=dthetadp*(f+(dvdx/cosphi-dudy | |
| 261 | + +uu(ix,jy,kl,n)*tanphi)/r_earth)*(-1.e6)*9.81 | |
| 262 | C | |
| 263 | C Resest jux and juy | |
| 264 | jux=jumpx | |
| 265 | juy=jumpy | |
| 266 | 12 continue | |
| 267 | 11 continue | |
| 268 | 10 continue | |
| 269 | C | |
| 270 | C Fill in missing PV values on poles, if present | |
| 271 | C Use mean PV of surrounding latitude ring | |
| 272 | C | |
| 273 | if (sglobal) then | |
| 274 | do 80 kl=1,nuvz | |
| 275 | pvavr=0. | |
| 276 | do 81 ix=0,nx-1 | |
| 277 | pvavr=pvavr+pv(ix,1,kl,n) | |
| 278 | 81 continue | |
| 279 | pvavr=pvavr/float(nx) | |
| 280 | jy=0 | |
| 281 | do 82 ix=0,nx-1 | |
| 282 | pv(ix,jy,kl,n)=pvavr | |
| 283 | 82 continue | |
| 284 | 80 continue | |
| 285 | end if | |
| 286 | if (nglobal) then | |
| 287 | do 90 kl=1,nuvz | |
| 288 | pvavr=0. | |
| 289 | do 91 ix=0,nx-1 | |
| 290 | pvavr=pvavr+pv(ix,ny-2,kl,n) | |
| 291 | 91 continue | |
| 292 | pvavr=pvavr/float(nx) | |
| 293 | jy=ny-1 | |
| 294 | do 92 ix=0,nx-1 | |
| 295 | pv(ix,jy,kl,n)=pvavr | |
| 296 | 92 continue | |
| 297 | 90 continue | |
| 298 | end if | |
| 299 | return | |
| 300 | end |
| 0 | subroutine calcpv_nests(l,n) | |
| 1 | C | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * Calculation of potential vorticity on 3-d nested grid * | |
| 5 | * * | |
| 6 | * Author: P. James * | |
| 7 | * 22 February 2000 * | |
| 8 | * * | |
| 9 | ******************************************************************************** | |
| 10 | * * | |
| 11 | * Variables: * | |
| 12 | * n temporal index for meteorological fields (1 to 3) * | |
| 13 | * l index of current nest * | |
| 14 | * * | |
| 15 | * Constants: * | |
| 16 | * * | |
| 17 | ******************************************************************************** | |
| 18 | ||
| 19 | include 'includepar' | |
| 20 | include 'includecom' | |
| 21 | ||
| 22 | integer n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch | |
| 23 | integer jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr | |
| 24 | integer nlck,l | |
| 25 | real vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f | |
| 26 | real theta,thetap,thetam,dthetadp,dt1,dt2,dt,ppmk | |
| 27 | real height(nuvzmax),ppml(nuvzmax) | |
| 28 | real thup,thdn | |
| 29 | ||
| 30 | C Set number of levels to check for adjacent theta | |
| 31 | nlck=nuvz/3 | |
| 32 | do 5 k=1,nuvz | |
| 33 | height(k)=akz(k)/p0+bkz(k) | |
| 34 | 5 continue | |
| 35 | C *** Precalculate all theta levels for efficiency | |
| 36 | do 9 jy=0,nyn(l)-1 | |
| 37 | do 14 kl=1,nuvz | |
| 38 | do 13 ix=0,nxn(l)-1 | |
| 39 | ppmk=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l) | |
| 40 | thn(ix,jy,kl,n,l)=ttn(ix,jy,kl,n,l)*(100000./ppmk)**kappa | |
| 41 | 13 continue | |
| 42 | 14 continue | |
| 43 | 9 continue | |
| 44 | C | |
| 45 | C Loop over entire grid | |
| 46 | *********************** | |
| 47 | do 10 jy=0,nyn(l)-1 | |
| 48 | phi = (ylat0n(l) + jy * dyn(l)) * pi / 180. | |
| 49 | f = 0.00014585 * sin(phi) | |
| 50 | tanphi = tan(phi) | |
| 51 | cosphi = cos(phi) | |
| 52 | C Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat) | |
| 53 | jyvp=jy+1 | |
| 54 | jyvm=jy-1 | |
| 55 | if (jy.eq.0) jyvm=0 | |
| 56 | if (jy.eq.nyn(l)-1) jyvp=nyn(l)-1 | |
| 57 | C Define absolute gap length | |
| 58 | jumpy=2 | |
| 59 | if (jy.eq.0.or.jy.eq.nyn(l)-1) jumpy=1 | |
| 60 | juy=jumpy | |
| 61 | C | |
| 62 | do 11 ix=0,nxn(l)-1 | |
| 63 | C Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long) | |
| 64 | ixvp=ix+1 | |
| 65 | ixvm=ix-1 | |
| 66 | jumpx=2 | |
| 67 | if (ix.eq.0) ixvm=0 | |
| 68 | if (ix.eq.nxn(l)-1) ixvp=nxn(l)-1 | |
| 69 | ivrp=ixvp | |
| 70 | ivrm=ixvm | |
| 71 | C Define absolute gap length | |
| 72 | if (ix.eq.0.or.ix.eq.nxn(l)-1) jumpx=1 | |
| 73 | jux=jumpx | |
| 74 | C Precalculate pressure values for efficiency | |
| 75 | do 8 kl=1,nuvz | |
| 76 | ppml(kl)=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l) | |
| 77 | 8 continue | |
| 78 | C | |
| 79 | C Loop over the vertical | |
| 80 | ************************ | |
| 81 | ||
| 82 | do 12 kl=1,nuvz | |
| 83 | theta=thn(ix,jy,kl,n,l) | |
| 84 | klvrp=kl+1 | |
| 85 | klvrm=kl-1 | |
| 86 | klpt=kl | |
| 87 | C If top or bottom level, dthetadp is evaluated between the current | |
| 88 | C level and the level inside, otherwise between level+1 and level-1 | |
| 89 | C | |
| 90 | if (klvrp.gt.nuvz) klvrp=nuvz | |
| 91 | if (klvrm.lt.1) klvrm=1 | |
| 92 | thetap=thn(ix,jy,klvrp,n,l) | |
| 93 | thetam=thn(ix,jy,klvrm,n,l) | |
| 94 | dthetadp=(thetap-thetam)/(ppml(klvrp)-ppml(klvrm)) | |
| 95 | ||
| 96 | C Compute vertical position at pot. temperature surface on subgrid | |
| 97 | C and the wind at that position | |
| 98 | ****************************************************************** | |
| 99 | C a) in x direction | |
| 100 | ii=0 | |
| 101 | do 20 i=ixvm,ixvp,jumpx | |
| 102 | ivr=i | |
| 103 | ii=ii+1 | |
| 104 | C Search adjacent levels for current theta value | |
| 105 | C Spiral out from current level for efficiency | |
| 106 | kup=klpt-1 | |
| 107 | kdn=klpt | |
| 108 | kch=0 | |
| 109 | 40 continue | |
| 110 | C Upward branch | |
| 111 | kup=kup+1 | |
| 112 | if (kch.ge.nlck) goto 21 ! No more levels to check, | |
| 113 | C ! and no values found | |
| 114 | if (kup.ge.nuvz) goto 41 | |
| 115 | kch=kch+1 | |
| 116 | k=kup | |
| 117 | thdn=thn(ivr,jy,k,n,l) | |
| 118 | thup=thn(ivr,jy,k+1,n,l) | |
| 119 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 120 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 121 | dt1=abs(theta-thdn) | |
| 122 | dt2=abs(theta-thup) | |
| 123 | dt=dt1+dt2 | |
| 124 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 125 | dt1=0.5 ! G.W., 10.4.1996 | |
| 126 | dt2=0.5 | |
| 127 | dt=1.0 | |
| 128 | endif | |
| 129 | vx(ii)=(vvn(ivr,jy,k,n,l)*dt2+vvn(ivr,jy,k+1,n,l)*dt1)/dt | |
| 130 | goto 20 | |
| 131 | endif | |
| 132 | 41 continue | |
| 133 | C Downward branch | |
| 134 | kdn=kdn-1 | |
| 135 | if (kdn.lt.1) goto 40 | |
| 136 | kch=kch+1 | |
| 137 | k=kdn | |
| 138 | thdn=thn(ivr,jy,k,n,l) | |
| 139 | thup=thn(ivr,jy,k+1,n,l) | |
| 140 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 141 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 142 | dt1=abs(theta-thdn) | |
| 143 | dt2=abs(theta-thup) | |
| 144 | dt=dt1+dt2 | |
| 145 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 146 | dt1=0.5 ! G.W., 10.4.1996 | |
| 147 | dt2=0.5 | |
| 148 | dt=1.0 | |
| 149 | endif | |
| 150 | vx(ii)=(vvn(ivr,jy,k,n,l)*dt2+vvn(ivr,jy,k+1,n,l)*dt1)/dt | |
| 151 | goto 20 | |
| 152 | endif | |
| 153 | goto 40 | |
| 154 | C This section used when no values were found | |
| 155 | 21 continue | |
| 156 | C Must use vv at current level and long. jux becomes smaller by 1 | |
| 157 | vx(ii)=vvn(ix,jy,kl,n,l) | |
| 158 | jux=jux-1 | |
| 159 | C Otherwise OK | |
| 160 | 20 continue | |
| 161 | if (jux.gt.0) then | |
| 162 | dvdx=(vx(2)-vx(1))/float(jux)/(dxn(l)*pi/180.) | |
| 163 | else | |
| 164 | dvdx=vvn(ivrp,jy,kl,n,l)-vvn(ivrm,jy,kl,n,l) | |
| 165 | dvdx=dvdx/float(jumpx)/(dxn(l)*pi/180.) | |
| 166 | C Only happens if no equivalent theta value | |
| 167 | C can be found on either side, hence must use values | |
| 168 | C from either side, same pressure level. | |
| 169 | end if | |
| 170 | ||
| 171 | C b) in y direction | |
| 172 | ||
| 173 | jj=0 | |
| 174 | do 50 j=jyvm,jyvp,jumpy | |
| 175 | jj=jj+1 | |
| 176 | C Search adjacent levels for current theta value | |
| 177 | C Spiral out from current level for efficiency | |
| 178 | kup=klpt-1 | |
| 179 | kdn=klpt | |
| 180 | kch=0 | |
| 181 | 70 continue | |
| 182 | C Upward branch | |
| 183 | kup=kup+1 | |
| 184 | if (kch.ge.nlck) goto 51 ! No more levels to check, | |
| 185 | C ! and no values found | |
| 186 | if (kup.ge.nuvz) goto 71 | |
| 187 | kch=kch+1 | |
| 188 | k=kup | |
| 189 | thdn=thn(ix,j,k,n,l) | |
| 190 | thup=thn(ix,j,k+1,n,l) | |
| 191 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 192 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 193 | dt1=abs(theta-thdn) | |
| 194 | dt2=abs(theta-thup) | |
| 195 | dt=dt1+dt2 | |
| 196 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 197 | dt1=0.5 ! G.W., 10.4.1996 | |
| 198 | dt2=0.5 | |
| 199 | dt=1.0 | |
| 200 | endif | |
| 201 | uy(jj)=(uun(ix,j,k,n,l)*dt2+uun(ix,j,k+1,n,l)*dt1)/dt | |
| 202 | goto 50 | |
| 203 | endif | |
| 204 | 71 continue | |
| 205 | C Downward branch | |
| 206 | kdn=kdn-1 | |
| 207 | if (kdn.lt.1) goto 70 | |
| 208 | kch=kch+1 | |
| 209 | k=kdn | |
| 210 | thdn=thn(ix,j,k,n,l) | |
| 211 | thup=thn(ix,j,k+1,n,l) | |
| 212 | if (((thdn.ge.theta).and.(thup.le.theta)).or. | |
| 213 | + ((thdn.le.theta).and.(thup.ge.theta))) then | |
| 214 | dt1=abs(theta-thdn) | |
| 215 | dt2=abs(theta-thup) | |
| 216 | dt=dt1+dt2 | |
| 217 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 218 | dt1=0.5 ! G.W., 10.4.1996 | |
| 219 | dt2=0.5 | |
| 220 | dt=1.0 | |
| 221 | endif | |
| 222 | uy(jj)=(uun(ix,j,k,n,l)*dt2+uun(ix,j,k+1,n,l)*dt1)/dt | |
| 223 | goto 50 | |
| 224 | endif | |
| 225 | goto 70 | |
| 226 | C This section used when no values were found | |
| 227 | 51 continue | |
| 228 | C Must use uu at current level and lat. juy becomes smaller by 1 | |
| 229 | uy(jj)=uun(ix,jy,kl,n,l) | |
| 230 | juy=juy-1 | |
| 231 | C Otherwise OK | |
| 232 | 50 continue | |
| 233 | if (juy.gt.0) then | |
| 234 | dudy=(uy(2)-uy(1))/float(juy)/(dyn(l)*pi/180.) | |
| 235 | else | |
| 236 | dudy=uun(ix,jyvp,kl,n,l)-uun(ix,jyvm,kl,n,l) | |
| 237 | dudy=dudy/float(jumpy)/(dyn(l)*pi/180.) | |
| 238 | end if | |
| 239 | C | |
| 240 | pvn(ix,jy,kl,n,l)=dthetadp*(f+(dvdx/cosphi-dudy | |
| 241 | + +uun(ix,jy,kl,n,l)*tanphi)/r_earth)*(-1.e6)*9.81 | |
| 242 | C | |
| 243 | C Resest jux and juy | |
| 244 | jux=jumpx | |
| 245 | juy=jumpy | |
| 246 | 12 continue | |
| 247 | 11 continue | |
| 248 | 10 continue | |
| 249 | C | |
| 250 | return | |
| 251 | end |
| 0 | SUBROUTINE caldate(JULDATE,YYYYMMDD,HHMISS) | |
| 1 | c i o o | |
| 2 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
| 3 | * * | |
| 4 | * Calculates the Gregorian date from the Julian date * | |
| 5 | * * | |
| 6 | * AUTHOR: Andreas Stohl (21 January 1994), adapted from Numerical Recipes * | |
| 7 | * * | |
| 8 | * Variables: * | |
| 9 | * DD Day * | |
| 10 | * HH Hour * | |
| 11 | * HHMISS Hour, Minute, Second * | |
| 12 | * JA,JB,JC,JD,JE help variables * | |
| 13 | * JALPHA help variable * | |
| 14 | * JULDATE Julian Date * | |
| 15 | * JULDAY help variable * | |
| 16 | * MI Minute * | |
| 17 | * MM Month * | |
| 18 | * SS Seconds * | |
| 19 | * YYYY Year * | |
| 20 | * YYYYMMDD Year, Month, Day * | |
| 21 | * * | |
| 22 | * Constants: * | |
| 23 | * IGREG help constant * | |
| 24 | * * | |
| 25 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
| 26 | ||
| 27 | IMPLICIT NONE | |
| 28 | ||
| 29 | INTEGER YYYYMMDD,YYYY,MM,DD,HHMISS,HH,MI,SS | |
| 30 | INTEGER JULDAY,JA,JB,JC,JD,JE,IGREG,JALPHA | |
| 31 | DOUBLE PRECISION JULDATE | |
| 32 | PARAMETER (IGREG=2299161) | |
| 33 | ||
| 34 | JULDAY=INT(JULDATE) | |
| 35 | IF(JULDAY.GE.IGREG)THEN | |
| 36 | JALPHA=INT(((JULDAY-1867216)-0.25)/36524.25) | |
| 37 | JA=JULDAY+1+JALPHA-INT(0.25*JALPHA) | |
| 38 | ELSE | |
| 39 | JA=JULDAY | |
| 40 | ENDIF | |
| 41 | JB=JA+1524 | |
| 42 | JC=INT(6680.+((JB-2439870)-122.1)/365.25) | |
| 43 | JD=365*JC+INT(0.25*JC) | |
| 44 | JE=INT((JB-JD)/30.6001) | |
| 45 | DD=JB-JD-INT(30.6001*JE) | |
| 46 | MM=JE-1 | |
| 47 | IF (MM.GT.12) MM=MM-12 | |
| 48 | YYYY=JC-4715 | |
| 49 | IF (MM.GT.2) YYYY=YYYY-1 | |
| 50 | IF (YYYY.LE.0) YYYY=YYYY-1 | |
| 51 | ||
| 52 | YYYYMMDD=10000*YYYY+100*MM+DD | |
| 53 | HH=INT(24.*(JULDATE-FLOAT(JULDAY))) | |
| 54 | MI=INT(1440.*(JULDATE-FLOAT(JULDAY))-60.*FLOAT(HH)) | |
| 55 | SS=NINT(86400.*(JULDATE-FLOAT(JULDAY))-3600.*FLOAT(HH)) | |
| 56 | +-60.*FLOAT(MI) | |
| 57 | IF (SS.EQ.60) THEN ! 60 seconds = 1 minute | |
| 58 | SS=0 | |
| 59 | MI=MI+1 | |
| 60 | ENDIF | |
| 61 | IF (MI.EQ.60) THEN | |
| 62 | MI=0 | |
| 63 | HH=HH+1 | |
| 64 | ENDIF | |
| 65 | HHMISS=10000*HH+100*MI+SS | |
| 66 | ||
| 67 | RETURN | |
| 68 | END |
| 0 | subroutine checklimits(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine checks, if the current user specifications are within the * | |
| 5 | * dimensional limits of the number of trajectories that have to be handled * | |
| 6 | * at the same time. * | |
| 7 | * * | |
| 8 | * Author: A. Stohl * | |
| 9 | * * | |
| 10 | * 2 February 1994 * | |
| 11 | * * | |
| 12 | ******************************************************************************** | |
| 13 | * * | |
| 14 | * Variables: * | |
| 15 | * error .true., if dimensions are exceeded, else .false. * | |
| 16 | * interv [s] interval between two trajectory calculations * | |
| 17 | * lentra [s] length of an individual trajectory * | |
| 18 | * numtramax wanted maximum number of trajectories * | |
| 19 | * * | |
| 20 | * Constants: * | |
| 21 | * maxtra maximum allowable number of trajectories * | |
| 22 | * * | |
| 23 | ******************************************************************************** | |
| 24 | ||
| 25 | include 'includepar' | |
| 26 | include 'includecom' | |
| 27 | ||
| 28 | integer numtramax | |
| 29 | logical error | |
| 30 | ||
| 31 | error=.false. | |
| 32 | ||
| 33 | 1 format(1x,a6,i7,a43) | |
| 34 | ||
| 35 | C Calculate maximum number of trajectories to be held in memory | |
| 36 | C If only one starting time is selected, numtramax=numpoint, otherwise it is | |
| 37 | C =(number of starting points)*(length of trajectories)/(interval of starting | |
| 38 | C times of trajectories) | |
| 39 | ***************************************************************************** | |
| 40 | ||
| 41 | if ((ibdate.eq.iedate).and.(ibtime.eq.ietime)) then | |
| 42 | numtramax=numpoint | |
| 43 | else | |
| 44 | numtramax=numpoint*int(float(abs(lentra))/float(interv)+1.) | |
| 45 | endif | |
| 46 | ||
| 47 | if (modecet.eq.3) then | |
| 48 | numtramax=1 | |
| 49 | endif | |
| 50 | ||
| 51 | ||
| 52 | C If numtramax is greater than the number allowed by maxtra, give a warning | |
| 53 | C and stop the model execution. | |
| 54 | *************************************************************************** | |
| 55 | ||
| 56 | if (numtramax.gt.maxtra) then | |
| 57 | error=.true. | |
| 58 | write(*,*) '##### !!!ERROR!!! # | |
| 59 | +####' | |
| 60 | write(*,*) '##### YOU WANT TO CALCULATE TOO MANY TRAJECTORIES: # | |
| 61 | +####' | |
| 62 | write(*,1) '##### ',numtramax,' ARE WANTED, BUT ONLY | |
| 63 | + #####' | |
| 64 | write(*,1) '##### ',maxtra,' ARE POSSIBLE. | |
| 65 | + #####' | |
| 66 | write(*,*) '##### YOU CAN AVOID THIS PROBLEM IN THREE WAYS: # | |
| 67 | +####' | |
| 68 | write(*,*) '##### 1) REDUCE THE NUMBER OF STARTING POINTS IN # | |
| 69 | +####' | |
| 70 | write(*,*) '##### FILE "STARTPOINTS". # | |
| 71 | +####' | |
| 72 | write(*,*) '##### 2) REDUCE THE CALCULATION LENGTH OF THE # | |
| 73 | +####' | |
| 74 | write(*,*) '##### TRAJECTORIES IN FILE "COMMAND". # | |
| 75 | +####' | |
| 76 | write(*,*) '##### 3) INCREASE THE TIME INTERVAL BETWEEN TWO # | |
| 77 | +####' | |
| 78 | write(*,*) '##### TRAJECTORY CALCULATIONS IN FILE "COMMAND".# | |
| 79 | +####' | |
| 80 | endif | |
| 81 | ||
| 82 | return | |
| 83 | end |
| 0 | C CHANGES TO THE ROUTINES BY A. STOHL | |
| 1 | C XI,XI0,ETA,ETA0 ARE DOUBLE PRECISION VARIABLES TO AVOID PROBLEMS | |
| 2 | C AT POLES | |
| 3 | ||
| 4 | SUBROUTINE CC2GLL (STRCMP, XLAT,XLONG, UE,VN, UG,VG) | |
| 5 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 6 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 7 | DOUBLE PRECISION XPOLG,YPOLG,ALONG,SLONG,CLONG,ROT | |
| 8 | REAL STRCMP(9) | |
| 9 | ALONG = CSPANF( XLONG - STRCMP(2), -180., 180.) | |
| 10 | IF (XLAT.GT.89.985) THEN | |
| 11 | C* NORTH POLAR METEOROLOGICAL ORIENTATION: "NORTH" ALONG PRIME MERIDIAN | |
| 12 | ROT = - STRCMP(1) * ALONG + XLONG - 180. | |
| 13 | ELSEIF (XLAT.LT.-89.985) THEN | |
| 14 | C* SOUTH POLAR METEOROLOGICAL ORIENTATION: "NORTH" ALONG PRIME MERIDIAN | |
| 15 | ROT = - STRCMP(1) * ALONG - XLONG | |
| 16 | ELSE | |
| 17 | ROT = - STRCMP(1) * ALONG | |
| 18 | ENDIF | |
| 19 | SLONG = SIN( RADPDG * ROT ) | |
| 20 | CLONG = COS( RADPDG * ROT ) | |
| 21 | XPOLG = SLONG * STRCMP(5) + CLONG * STRCMP(6) | |
| 22 | YPOLG = CLONG * STRCMP(5) - SLONG * STRCMP(6) | |
| 23 | UG = YPOLG * UE + XPOLG * VN | |
| 24 | VG = YPOLG * VN - XPOLG * UE | |
| 25 | RETURN | |
| 26 | END | |
| 27 | ||
| 28 | SUBROUTINE CCRVLL (STRCMP, XLAT,XLONG, GX,GY) | |
| 29 | C* WRITTEN ON 9/20/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 30 | PARAMETER (REARTH=6 371.2) | |
| 31 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 32 | DOUBLE PRECISION XPOLG,YPOLG,TEMP,ALONG,SLONG,CLONG,CTEMP | |
| 33 | REAL STRCMP(9) | |
| 34 | ALONG = CSPANF( XLONG - STRCMP(2), -180., 180.) | |
| 35 | SLONG = SIN( RADPDG * STRCMP(1) * ALONG) | |
| 36 | CLONG = COS( RADPDG * STRCMP(1) * ALONG) | |
| 37 | XPOLG = - SLONG * STRCMP(5) + CLONG * STRCMP(6) | |
| 38 | YPOLG = CLONG * STRCMP(5) + SLONG * STRCMP(6) | |
| 39 | TEMP = SIN(RADPDG * XLAT) | |
| 40 | CTEMP = COS(RADPDG * XLAT) | |
| 41 | CURV = (STRCMP(1) - TEMP) / CTEMP / REARTH | |
| 42 | GX = CURV * XPOLG | |
| 43 | GY = CURV * YPOLG | |
| 44 | RETURN | |
| 45 | END | |
| 46 | ||
| 47 | SUBROUTINE CCRVXY (STRCMP, X,Y, GX,GY) | |
| 48 | C* WRITTEN ON 9/20/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 49 | PARAMETER (REARTH=6 371.2) | |
| 50 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 51 | REAL STRCMP(9) | |
| 52 | DOUBLE PRECISION XPOLG,YPOLG,TEMP,YMERC,EFACT,CURV | |
| 53 | TEMP = STRCMP(1) * STRCMP(7) /REARTH | |
| 54 | XPOLG = STRCMP(6) + TEMP * (STRCMP(3) - X) | |
| 55 | YPOLG = STRCMP(5) + TEMP * (STRCMP(4) - Y) | |
| 56 | TEMP = SQRT ( XPOLG ** 2 + YPOLG ** 2 ) | |
| 57 | IF (TEMP.GT.0.) THEN | |
| 58 | YMERC = - LOG( TEMP) /STRCMP(1) | |
| 59 | EFACT = EXP(YMERC) | |
| 60 | CURV = ( (STRCMP(1) - 1.D0) * EFACT + | |
| 61 | A (STRCMP(1) + 1.D0) / EFACT ) | |
| 62 | B * .5D0 / REARTH | |
| 63 | GX = XPOLG * CURV / TEMP | |
| 64 | GY = YPOLG * CURV / TEMP | |
| 65 | ELSE | |
| 66 | IF (ABS(STRCMP(1)) .EQ. 1.) THEN | |
| 67 | GX = 0. | |
| 68 | GY = 0. | |
| 69 | ELSE | |
| 70 | GX = 1./REARTH | |
| 71 | GY = 1./REARTH | |
| 72 | ENDIF | |
| 73 | ENDIF | |
| 74 | RETURN | |
| 75 | END | |
| 76 | ||
| 77 | SUBROUTINE CG2CLL (STRCMP, XLAT,XLONG, UG,VG, UE,VN) | |
| 78 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 79 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 80 | DOUBLE PRECISION XPOLG,YPOLG,ALONG,SLONG,CLONG,ROT | |
| 81 | REAL STRCMP(9) | |
| 82 | ALONG = CSPANF( XLONG - STRCMP(2), -180., 180.) | |
| 83 | IF (XLAT.GT.89.985) THEN | |
| 84 | C* NORTH POLAR METEOROLOGICAL ORIENTATION: "NORTH" ALONG PRIME MERIDIAN | |
| 85 | ROT = - STRCMP(1) * ALONG + XLONG - 180. | |
| 86 | ELSEIF (XLAT.LT.-89.985) THEN | |
| 87 | C* SOUTH POLAR METEOROLOGICAL ORIENTATION: "NORTH" ALONG PRIME MERIDIAN | |
| 88 | ROT = - STRCMP(1) * ALONG - XLONG | |
| 89 | ELSE | |
| 90 | ROT = - STRCMP(1) * ALONG | |
| 91 | ENDIF | |
| 92 | SLONG = SIN( RADPDG * ROT ) | |
| 93 | CLONG = COS( RADPDG * ROT ) | |
| 94 | XPOLG = SLONG * STRCMP(5) + CLONG * STRCMP(6) | |
| 95 | YPOLG = CLONG * STRCMP(5) - SLONG * STRCMP(6) | |
| 96 | UE = YPOLG * UG - XPOLG * VG | |
| 97 | VN = YPOLG * VG + XPOLG * UG | |
| 98 | RETURN | |
| 99 | END | |
| 100 | ||
| 101 | SUBROUTINE CG2CXY (STRCMP, X,Y, UG,VG, UE,VN) | |
| 102 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 103 | PARAMETER (REARTH=6 371.2) | |
| 104 | REAL STRCMP(9) | |
| 105 | DOUBLE PRECISION XPOLG,YPOLG,TEMP,XI0,ETA0,XI,ETA | |
| 106 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 107 | XI0 = ( X - STRCMP(3) ) * STRCMP(7) / REARTH | |
| 108 | ETA0 = ( Y - STRCMP(4) ) * STRCMP(7) /REARTH | |
| 109 | XI = XI0 * STRCMP(5) - ETA0 * STRCMP(6) | |
| 110 | ETA = ETA0 * STRCMP(5) + XI0 * STRCMP(6) | |
| 111 | RADIAL = 2. * ETA - STRCMP(1) * (XI*XI + ETA*ETA) | |
| 112 | IF (RADIAL.GT.STRCMP(8)) THEN | |
| 113 | C* CASE NORTH OF 89 DEGREES. METEOROLOGICAL WIND DIRECTION DEFINITION | |
| 114 | C* CHANGES. | |
| 115 | CALL CNXYLL(STRCMP, XI,ETA, XLAT,XLONG) | |
| 116 | C* NORTH POLAR METEOROLOGICAL ORIENTATION: "NORTH" ALONG PRIME MERIDIAN | |
| 117 | ROT = STRCMP(1) * (XLONG - STRCMP(2)) - XLONG - 180. | |
| 118 | SLONG = - SIN( RADPDG * ROT ) | |
| 119 | CLONG = COS( RADPDG * ROT ) | |
| 120 | XPOLG = SLONG * STRCMP(5) + CLONG * STRCMP(6) | |
| 121 | YPOLG = CLONG * STRCMP(5) - SLONG * STRCMP(6) | |
| 122 | ELSE IF (RADIAL.LT.STRCMP(9)) THEN | |
| 123 | C* CASE SOUTH OF -89 DEGREES. METEOROLOGICAL WIND DIRECTION DEFINITION | |
| 124 | C* CHANGES. | |
| 125 | CALL CNXYLL(STRCMP, XI,ETA, XLAT,XLONG) | |
| 126 | C* SOUTH POLAR METEOROLOGICAL ORIENTATION: "NORTH" ALONG PRIME MERIDIAN | |
| 127 | ROT = STRCMP(1) * (XLONG - STRCMP(2)) + XLONG | |
| 128 | SLONG = - SIN( RADPDG * ROT ) | |
| 129 | CLONG = COS( RADPDG * ROT ) | |
| 130 | XPOLG = SLONG * STRCMP(5) + CLONG * STRCMP(6) | |
| 131 | YPOLG = CLONG * STRCMP(5) - SLONG * STRCMP(6) | |
| 132 | ELSE | |
| 133 | C* NORMAL CASE. METEOROLOGICAL DIRECTION OF WIND RELATED TO TRUE NORTH. | |
| 134 | XPOLG = STRCMP(6) - STRCMP(1) * XI0 | |
| 135 | YPOLG = STRCMP(5) - STRCMP(1) * ETA0 | |
| 136 | TEMP = SQRT ( XPOLG ** 2 + YPOLG ** 2 ) | |
| 137 | XPOLG = XPOLG / TEMP | |
| 138 | YPOLG = YPOLG / TEMP | |
| 139 | END IF | |
| 140 | UE = ( YPOLG * UG - XPOLG * VG ) | |
| 141 | VN = ( YPOLG * VG + XPOLG * UG ) | |
| 142 | RETURN | |
| 143 | END | |
| 144 | ||
| 145 | REAL FUNCTION CGSZLL (STRCMP, XLAT,XLONG) | |
| 146 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 147 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180D0/PI) | |
| 148 | REAL STRCMP(9) | |
| 149 | DOUBLE PRECISION SLAT,YMERC,EFACT | |
| 150 | IF (XLAT .GT. 89.985) THEN | |
| 151 | C* CLOSE TO NORTH POLE | |
| 152 | IF (STRCMP(1) .GT. 0.9999) THEN | |
| 153 | C* AND TO GAMMA == 1. | |
| 154 | CGSZLL = 2. * STRCMP(7) | |
| 155 | RETURN | |
| 156 | ENDIF | |
| 157 | EFACT = COS(RADPDG * XLAT) | |
| 158 | IF (EFACT .LE. 0.) THEN | |
| 159 | CGSZLL = 0. | |
| 160 | RETURN | |
| 161 | ELSE | |
| 162 | YMERC = - LOG( EFACT /(1. + SIN(RADPDG * XLAT))) | |
| 163 | ENDIF | |
| 164 | ELSE IF (XLAT .LT. -89.985) THEN | |
| 165 | C* CLOSE TO SOUTH POLE | |
| 166 | IF (STRCMP(1) .LT. -0.9999) THEN | |
| 167 | C* AND TO GAMMA == -1.0 | |
| 168 | CGSZLL = 2. * STRCMP(7) | |
| 169 | RETURN | |
| 170 | ENDIF | |
| 171 | EFACT = COS(RADPDG * XLAT) | |
| 172 | IF (EFACT .LE. 0.) THEN | |
| 173 | CGSZLL = 0. | |
| 174 | RETURN | |
| 175 | ELSE | |
| 176 | YMERC = LOG( EFACT /(1. - SIN(RADPDG * XLAT))) | |
| 177 | ENDIF | |
| 178 | ELSE | |
| 179 | SLAT = SIN(RADPDG * XLAT) | |
| 180 | YMERC = LOG((1. + SLAT) / (1. - SLAT))/2. | |
| 181 | C EFACT = EXP(YMERC) | |
| 182 | C CGSZLL = 2. * STRCMP(7) * EXP (STRCMP(1) * YMERC) | |
| 183 | C C / (EFACT + 1./EFACT) | |
| 184 | ENDIF | |
| 185 | CGSZLL = STRCMP(7) * COS(RADPDG * XLAT) * EXP(STRCMP(1) *YMERC) | |
| 186 | RETURN | |
| 187 | END | |
| 188 | ||
| 189 | REAL FUNCTION CGSZXY (STRCMP, X,Y) | |
| 190 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 191 | PARAMETER (REARTH=6 371.2,ALMST1=.9999999) | |
| 192 | REAL STRCMP(9) | |
| 193 | DOUBLE PRECISION YMERC,EFACT | |
| 194 | DOUBLE PRECISION XI0,ETA0,XI,ETA | |
| 195 | XI0 = ( X - STRCMP(3) ) * STRCMP(7) / REARTH | |
| 196 | ETA0 = ( Y - STRCMP(4) ) * STRCMP(7) /REARTH | |
| 197 | XI = XI0 * STRCMP(5) - ETA0 * STRCMP(6) | |
| 198 | ETA = ETA0 * STRCMP(5) + XI0 * STRCMP(6) | |
| 199 | RADIAL = 2. * ETA - STRCMP(1) * (XI*XI + ETA*ETA) | |
| 200 | EFACT = STRCMP(1) * RADIAL | |
| 201 | IF (EFACT .GT. ALMST1) THEN | |
| 202 | IF (STRCMP(1).GT.ALMST1) THEN | |
| 203 | CGSZXY = 2. * STRCMP(7) | |
| 204 | ELSE | |
| 205 | CGSZXY = 0. | |
| 206 | ENDIF | |
| 207 | RETURN | |
| 208 | ENDIF | |
| 209 | IF (ABS(EFACT) .LT. 1.E-2) THEN | |
| 210 | TEMP = (EFACT / (2. - EFACT) )**2 | |
| 211 | YMERC = RADIAL / (2. - EFACT) * (1. + TEMP * | |
| 212 | C (1./3. + TEMP * | |
| 213 | C (1./5. + TEMP * | |
| 214 | C (1./7. )))) | |
| 215 | ELSE | |
| 216 | YMERC = - LOG( 1. - EFACT ) /2. /STRCMP(1) | |
| 217 | ENDIF | |
| 218 | IF (YMERC .GT. 6.) THEN | |
| 219 | IF (STRCMP(1) .GT. ALMST1) THEN | |
| 220 | CGSZXY = 2. * STRCMP(7) | |
| 221 | ELSE | |
| 222 | CGSZXY = 0. | |
| 223 | ENDIF | |
| 224 | ELSE IF (YMERC .LT. -6.) THEN | |
| 225 | IF (STRCMP(1) .LT. -ALMST1) THEN | |
| 226 | CGSZXY = 2. * STRCMP(7) | |
| 227 | ELSE | |
| 228 | CGSZXY = 0. | |
| 229 | ENDIF | |
| 230 | ELSE | |
| 231 | EFACT = EXP(YMERC) | |
| 232 | CGSZXY = 2. * STRCMP(7) * EXP (STRCMP(1) * YMERC) | |
| 233 | C / (EFACT + 1./EFACT) | |
| 234 | ENDIF | |
| 235 | RETURN | |
| 236 | END | |
| 237 | ||
| 238 | SUBROUTINE CLL2XY (STRCMP, XLAT,XLONG, X,Y) | |
| 239 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 240 | PARAMETER (REARTH=6 371.2) | |
| 241 | REAL STRCMP(9) | |
| 242 | CALL CNLLXY(STRCMP, XLAT,XLONG, XI,ETA) | |
| 243 | X = STRCMP(3) + REARTH/STRCMP(7) * | |
| 244 | C (XI * STRCMP(5) + ETA * STRCMP(6) ) | |
| 245 | Y = STRCMP(4) + REARTH/STRCMP(7) * | |
| 246 | C (ETA * STRCMP(5) - XI * STRCMP(6) ) | |
| 247 | RETURN | |
| 248 | END | |
| 249 | ||
| 250 | SUBROUTINE CNLLXY (STRCMP, XLAT,XLONG, XI,ETA) | |
| 251 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 252 | C MAIN TRANSFORMATION ROUTINE FROM LATITUDE-LONGITUDE TO | |
| 253 | C CANONICAL (EQUATOR-CENTERED, RADIAN UNIT) COORDINATES | |
| 254 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 255 | PARAMETER (ALMST1=.9999999) | |
| 256 | REAL STRCMP(9) | |
| 257 | DOUBLE PRECISION GAMMA | |
| 258 | DOUBLE PRECISION DLONG,DLAT,SLAT,MERCY,GMERCY | |
| 259 | GAMMA = STRCMP(1) | |
| 260 | DLAT = XLAT | |
| 261 | DLONG = CSPANF(XLONG - STRCMP(2), -180., 180.) | |
| 262 | DLONG = DLONG * RADPDG | |
| 263 | GDLONG = GAMMA * DLONG | |
| 264 | IF (ABS(GDLONG) .LT. .01) THEN | |
| 265 | C CODE FOR GAMMA SMALL OR ZERO. THIS AVOIDS ROUND-OFF ERROR OR DIVIDE- | |
| 266 | C BY ZERO IN THE CASE OF MERCATOR OR NEAR-MERCATOR PROJECTIONS. | |
| 267 | GDLONG = GDLONG * GDLONG | |
| 268 | SNDGAM = DLONG * (1. - 1./6. * GDLONG * | |
| 269 | C (1. - 1./20. * GDLONG * | |
| 270 | C (1. - 1./42. * GDLONG ))) | |
| 271 | CSDGAM = DLONG * DLONG * .5 * | |
| 272 | C (1. - 1./12. * GDLONG * | |
| 273 | C (1. - 1./30. * GDLONG * | |
| 274 | C (1. - 1./56. * GDLONG ))) | |
| 275 | ELSE | |
| 276 | C CODE FOR MODERATE VALUES OF GAMMA | |
| 277 | SNDGAM = SIN (GDLONG) /GAMMA | |
| 278 | CSDGAM = (1. - COS(GDLONG) )/GAMMA /GAMMA | |
| 279 | ENDIF | |
| 280 | SLAT = SIN(RADPDG * DLAT) | |
| 281 | IF ((SLAT .GE. ALMST1) .OR. (SLAT .LE. -ALMST1)) THEN | |
| 282 | ETA = 1./STRCMP(1) | |
| 283 | XI = 0. | |
| 284 | RETURN | |
| 285 | ENDIF | |
| 286 | MERCY = .5 * LOG( (1. + SLAT) / (1. - SLAT) ) | |
| 287 | GMERCY = GAMMA * MERCY | |
| 288 | IF (ABS(GMERCY) .LT. .001) THEN | |
| 289 | C CODE FOR GAMMA SMALL OR ZERO. THIS AVOIDS ROUND-OFF ERROR OR DIVIDE- | |
| 290 | C BY ZERO IN THE CASE OF MERCATOR OR NEAR-MERCATOR PROJECTIONS. | |
| 291 | RHOG1 = MERCY * (1. - .5 * GMERCY * | |
| 292 | C (1. - 1./3. * GMERCY * | |
| 293 | C (1. - 1./4. * GMERCY ) ) ) | |
| 294 | ELSE | |
| 295 | C CODE FOR MODERATE VALUES OF GAMMA | |
| 296 | RHOG1 = (1. - EXP(-GMERCY)) / GAMMA | |
| 297 | ENDIF | |
| 298 | ETA = RHOG1 + (1. - GAMMA * RHOG1) * GAMMA * CSDGAM | |
| 299 | XI = (1. - GAMMA * RHOG1 ) * SNDGAM | |
| 300 | END | |
| 301 | ||
| 302 | SUBROUTINE CNXYLL (STRCMP, XI,ETA, XLAT,XLONG) | |
| 303 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 304 | C MAIN TRANSFORMATION ROUTINE FROM CANONICAL (EQUATOR-CENTERED, | |
| 305 | C RADIAN UNIT) COORDINATES | |
| 306 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 307 | PARAMETER (ALMST1=.9999999) | |
| 308 | REAL STRCMP(9) | |
| 309 | DOUBLE PRECISION GAMMA,TEMP,ARG1,ARG2,YMERC,ALONG,GXI,CGETA | |
| 310 | DOUBLE PRECISION XI,ETA | |
| 311 | GAMMA = STRCMP(1) | |
| 312 | C CALCULATE EQUIVALENT MERCATOR COORDINATE | |
| 313 | ODIST = XI*XI + ETA*ETA | |
| 314 | ARG2 = 2. * ETA - GAMMA * (XI*XI + ETA*ETA) | |
| 315 | ARG1 = GAMMA * ARG2 | |
| 316 | C Change by A. Stohl to avoid problems close to the poles | |
| 317 | C IF (ARG1 .GE. ALMST1) THEN | |
| 318 | C DISTANCE TO NORTH (OR SOUTH) POLE IS ZERO (OR IMAGINARY ;) ) | |
| 319 | C XLAT = SIGN(90.,STRCMP(1)) | |
| 320 | C XLONG = STRCMP(2) | |
| 321 | C RETURN | |
| 322 | C ENDIF | |
| 323 | IF (ABS(ARG1) .LT. .01) THEN | |
| 324 | C CODE FOR GAMMA SMALL OR ZERO. THIS AVOIDS ROUND-OFF ERROR OR DIVIDE- | |
| 325 | C BY ZERO IN THE CASE OF MERCATOR OR NEAR-MERCATOR PROJECTIONS. | |
| 326 | TEMP = (ARG1 / (2. - ARG1) )**2 | |
| 327 | YMERC = ARG2 / (2. - ARG1) * (1. + TEMP * | |
| 328 | C (1./3. + TEMP * | |
| 329 | C (1./5. + TEMP * | |
| 330 | C (1./7. )))) | |
| 331 | ELSE | |
| 332 | C CODE FOR MODERATE VALUES OF GAMMA | |
| 333 | YMERC = - LOG ( 1. - ARG1 ) /2. / GAMMA | |
| 334 | ENDIF | |
| 335 | C CONVERT YMERC TO LATITUDE | |
| 336 | TEMP = EXP( - ABS(YMERC) ) | |
| 337 | XLAT = SIGN(ATAN2((1. - TEMP) * (1. + TEMP), 2. * TEMP), YMERC) | |
| 338 | C FIND LONGITUDES | |
| 339 | GXI = GAMMA*XI | |
| 340 | CGETA = 1. - GAMMA * ETA | |
| 341 | IF ( ABS(GXI) .LT. .01*CGETA ) THEN | |
| 342 | C CODE FOR GAMMA SMALL OR ZERO. THIS AVOIDS ROUND-OFF ERROR OR DIVIDE- | |
| 343 | C BY ZERO IN THE CASE OF MERCATOR OR NEAR-MERCATOR PROJECTIONS. | |
| 344 | TEMP = ( GXI /CGETA )**2 | |
| 345 | ALONG = XI / CGETA * (1. - TEMP * | |
| 346 | C (1./3. - TEMP * | |
| 347 | C (1./5. - TEMP * | |
| 348 | C (1./7. )))) | |
| 349 | ELSE | |
| 350 | C CODE FOR MODERATE VALUES OF GAMMA | |
| 351 | ALONG = ATAN2( GXI, CGETA) / GAMMA | |
| 352 | ENDIF | |
| 353 | XLONG = SNGL(STRCMP(2) + DGPRAD * ALONG) | |
| 354 | XLAT = XLAT * DGPRAD | |
| 355 | RETURN | |
| 356 | END | |
| 357 | ||
| 358 | SUBROUTINE CPOLLL (STRCMP, XLAT,XLONG, ENX,ENY,ENZ) | |
| 359 | C* WRITTEN ON 11/23/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 360 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180.,DGPRAD=180./PI) | |
| 361 | DOUBLE PRECISION XPOLG,YPOLG,ALONG,SLONG,CLONG,ROT | |
| 362 | REAL STRCMP(9) | |
| 363 | ALONG = CSPANF( XLONG - STRCMP(2), -180., 180.) | |
| 364 | ROT = - STRCMP(1) * ALONG | |
| 365 | SLONG = SIN( RADPDG * ROT ) | |
| 366 | CLONG = COS( RADPDG * ROT ) | |
| 367 | XPOLG = SLONG * STRCMP(5) + CLONG * STRCMP(6) | |
| 368 | YPOLG = CLONG * STRCMP(5) - SLONG * STRCMP(6) | |
| 369 | CLAT = COS(RADPDG * XLAT) | |
| 370 | ENX = CLAT * XPOLG | |
| 371 | ENY = CLAT * YPOLG | |
| 372 | ENZ = SIN(RADPDG * XLAT) | |
| 373 | RETURN | |
| 374 | END | |
| 375 | ||
| 376 | SUBROUTINE CPOLXY (STRCMP, X,Y, ENX,ENY,ENZ) | |
| 377 | C* WRITTEN ON 11/26/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 378 | PARAMETER (REARTH=6 371.2) | |
| 379 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 380 | REAL STRCMP(9) | |
| 381 | DOUBLE PRECISION XPOL,YPOL,TEMP,XI0,ETA0,XI,ETA,RADIAL | |
| 382 | DOUBLE PRECISION TEMP2,YMERC,ARG,OARG,CLAT | |
| 383 | XI0 = ( X - STRCMP(3) ) * STRCMP(7) / REARTH | |
| 384 | ETA0 = ( Y - STRCMP(4) ) * STRCMP(7) /REARTH | |
| 385 | XI = XI0 * STRCMP(5) - ETA0 * STRCMP(6) | |
| 386 | ETA = ETA0 * STRCMP(5) + XI0 * STRCMP(6) | |
| 387 | RADIAL = 2. * ETA - STRCMP(1) * (XI*XI + ETA*ETA) | |
| 388 | TEMP = STRCMP(1) * RADIAL | |
| 389 | IF (TEMP .GE. 1.) THEN | |
| 390 | ENX = 0. | |
| 391 | ENY = 0. | |
| 392 | ENZ = SIGN(1.,STRCMP(1)) | |
| 393 | RETURN | |
| 394 | ENDIF | |
| 395 | IF (ABS(TEMP).LT.1.E-2) THEN | |
| 396 | TEMP2 = (TEMP / (2. - TEMP))**2 | |
| 397 | YMERC = RADIAL / (2. - TEMP) * (1. + TEMP2 * | |
| 398 | C (1./3. + TEMP2 * | |
| 399 | C (1./5. + TEMP2 * | |
| 400 | C (1./7.)))) | |
| 401 | ELSE | |
| 402 | YMERC = -.5 * LOG(1. - TEMP) / STRCMP(1) | |
| 403 | ENDIF | |
| 404 | ARG = EXP( YMERC ) | |
| 405 | OARG = 1./ARG | |
| 406 | CLAT = 2./(ARG + OARG) | |
| 407 | ENZ = (ARG - OARG) * CLAT /2. | |
| 408 | TEMP = CLAT / SQRT(1. - TEMP) | |
| 409 | XPOL = - XI * STRCMP(1) * TEMP | |
| 410 | YPOL = (1. - ETA * STRCMP(1) ) * TEMP | |
| 411 | ENX = XPOL * STRCMP(5) + YPOL * STRCMP(6) | |
| 412 | ENY = YPOL * STRCMP(5) - XPOL * STRCMP(6) | |
| 413 | RETURN | |
| 414 | END | |
| 415 | ||
| 416 | REAL FUNCTION CSPANF (VALUE, BEGIN, END) | |
| 417 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 418 | C* REAL FUNCTION CSPANF RETURNS A VALUE IN THE INTERVAL (BEGIN,END] | |
| 419 | C* WHICH IS EQUIVALENT TO VALUE, MOD (END - BEGIN). IT IS USED TO | |
| 420 | C* REDUCE PERIODIC VARIABLES TO A STANDARD RANGE. IT ADJUSTS FOR THE | |
| 421 | C* BEHAVIOR OF THE MOD FUNCTION WHICH PROVIDES POSITIVE RESULTS FOR | |
| 422 | c* POSITIVE INPUT, AND NEGATIVE RESULTS FOR NEGATIVE INPUT | |
| 423 | C* INPUT: | |
| 424 | C* VALUE - REAL NUMBER TO BE REDUCED TO THE SPAN | |
| 425 | C* BEGIN - FIRST VALUE OF THE SPAN | |
| 426 | C* END - LAST VALUE OF THE SPAN | |
| 427 | C* RETURNS: | |
| 428 | C* THE REDUCED VALUE | |
| 429 | C* EXAMPLES: | |
| 430 | C* ALONG = CSPANF(XLONG, -180., +180.) | |
| 431 | C* DIR = CSPANF(ANGLE, 0., 360.) | |
| 432 | REAL FIRST,LAST | |
| 433 | FIRST = MIN(BEGIN,END) | |
| 434 | LAST = MAX(BEGIN,END) | |
| 435 | VAL = MOD( VALUE - FIRST , LAST - FIRST) | |
| 436 | IF ( VAL . LE. 0.) THEN | |
| 437 | CSPANF = VAL + LAST | |
| 438 | ELSE | |
| 439 | CSPANF = VAL + FIRST | |
| 440 | ENDIF | |
| 441 | RETURN | |
| 442 | END | |
| 443 | ||
| 444 | SUBROUTINE CXY2LL (STRCMP, X,Y, XLAT,XLONG) | |
| 445 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 446 | PARAMETER (REARTH=6 371.2) | |
| 447 | DOUBLE PRECISION XI0,ETA0,XI,ETA | |
| 448 | REAL STRCMP(9) | |
| 449 | XI0 = ( X - STRCMP(3) ) * STRCMP(7) / REARTH | |
| 450 | ETA0 = ( Y - STRCMP(4) ) * STRCMP(7) /REARTH | |
| 451 | XI = XI0 * STRCMP(5) - ETA0 * STRCMP(6) | |
| 452 | ETA = ETA0 * STRCMP(5) + XI0 * STRCMP(6) | |
| 453 | CALL CNXYLL(STRCMP, XI,ETA, XLAT,XLONG) | |
| 454 | XLONG = CSPANF(XLONG, -180., 180.) | |
| 455 | RETURN | |
| 456 | END | |
| 457 | ||
| 458 | REAL FUNCTION EQVLAT (XLAT1,XLAT2) | |
| 459 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 460 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 461 | SIND(X) = SIN (RADPDG*X) | |
| 462 | SINL1 = SIND (XLAT1) | |
| 463 | SINL2 = SIND (XLAT2) | |
| 464 | IF (ABS(SINL1 - SINL2) .GT. .001) THEN | |
| 465 | AL1 = LOG((1. - SINL1)/(1. - SINL2)) | |
| 466 | AL2 = LOG((1. + SINL1)/(1. + SINL2)) | |
| 467 | ELSE | |
| 468 | C CASE LAT1 NEAR OR EQUAL TO LAT2 | |
| 469 | TAU = - (SINL1 - SINL2)/(2. - SINL1 - SINL2) | |
| 470 | TAU = TAU*TAU | |
| 471 | AL1 = 2. / (2. - SINL1 - SINL2) * (1. + TAU * | |
| 472 | C (1./3. + TAU * | |
| 473 | C (1./5. + TAU * | |
| 474 | C (1./7.)))) | |
| 475 | TAU = (SINL1 - SINL2)/(2. + SINL1 + SINL2) | |
| 476 | TAU = TAU*TAU | |
| 477 | AL2 = -2. / (2. + SINL1 + SINL2) * (1. + TAU * | |
| 478 | C (1./3. + TAU * | |
| 479 | C (1./5. + TAU * | |
| 480 | C (1./7.)))) | |
| 481 | ENDIF | |
| 482 | EQVLAT = ASIN((AL1 + AL2) / (AL1 - AL2))/RADPDG | |
| 483 | RETURN | |
| 484 | END | |
| 485 | ||
| 486 | SUBROUTINE STCM1P(STRCMP, X1,Y1, XLAT1,XLONG1, | |
| 487 | C XLATG,XLONGG, GRIDSZ, ORIENT) | |
| 488 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 489 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 490 | REAL STRCMP(9) | |
| 491 | DO K=3,4 | |
| 492 | STRCMP (K) = 0. | |
| 493 | ENDDO | |
| 494 | TURN = RADPDG * (ORIENT - STRCMP(1) * | |
| 495 | C CSPANF(XLONGG - STRCMP(2), -180., 180.) ) | |
| 496 | STRCMP (5) = COS (TURN) | |
| 497 | STRCMP (6) = - SIN (TURN) | |
| 498 | STRCMP (7) = 1. | |
| 499 | STRCMP (7) = GRIDSZ * STRCMP(7) | |
| 500 | C / CGSZLL(STRCMP, XLATG, STRCMP(2)) | |
| 501 | CALL CLL2XY (STRCMP, XLAT1,XLONG1, X1A,Y1A) | |
| 502 | STRCMP(3) = STRCMP(3) + X1 - X1A | |
| 503 | STRCMP(4) = STRCMP(4) + Y1 - Y1A | |
| 504 | RETURN | |
| 505 | END | |
| 506 | ||
| 507 | SUBROUTINE STCM2P(STRCMP, X1,Y1, XLAT1,XLONG1, | |
| 508 | C X2,Y2, XLAT2,XLONG2) | |
| 509 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 510 | REAL STRCMP(9) | |
| 511 | DO K=3,6 | |
| 512 | STRCMP (K) = 0. | |
| 513 | ENDDO | |
| 514 | STRCMP (5) = 1. | |
| 515 | STRCMP (7) = 1. | |
| 516 | CALL CLL2XY (STRCMP, XLAT1,XLONG1, X1A,Y1A) | |
| 517 | CALL CLL2XY (STRCMP, XLAT2,XLONG2, X2A,Y2A) | |
| 518 | DEN = SQRT( (X1 - X2)**2 + (Y1 - Y2)**2 ) | |
| 519 | DENA = SQRT( (X1A - X2A)**2 + (Y1A - Y2A)**2 ) | |
| 520 | STRCMP(5) = ((X1A - X2A)*(X1 - X2) + (Y1A - Y2A) * (Y1 - Y2)) | |
| 521 | C /DEN /DENA | |
| 522 | STRCMP(6) = ((Y1A - Y2A)*(X1 - X2) - (X1A - X2A) * (Y1 - Y2)) | |
| 523 | C /DEN /DENA | |
| 524 | STRCMP (7) = STRCMP(7) * DENA / DEN | |
| 525 | CALL CLL2XY (STRCMP, XLAT1,XLONG1, X1A,Y1A) | |
| 526 | STRCMP(3) = STRCMP(3) + X1 - X1A | |
| 527 | STRCMP(4) = STRCMP(4) + Y1 - Y1A | |
| 528 | RETURN | |
| 529 | END | |
| 530 | ||
| 531 | C* GENERAL CONFORMAL MAP ROUTINES FOR METEOROLOGICAL MODELERS | |
| 532 | C* WRITTEN ON 3/31/94 BY | |
| 533 | ||
| 534 | C* Dr. Albion Taylor | |
| 535 | C* NOAA / OAR / ARL Phone: (301) 713-0295 x 132 | |
| 536 | C* Rm. 3151, 1315 East-West Highway Fax: (301) 713-0119 | |
| 537 | C* Silver Spring, MD 20910 E-mail: ADTaylor@arlrisc.ssmc.noaa.gov | |
| 538 | ||
| 539 | C* SUBROUTINE STLMBR (STRCMP, TNGLAT, CLONG) | |
| 540 | C* THIS ROUTINE INITIALIZES THE MAP STRUCTURE ARRAY STRCMP TO | |
| 541 | C* THE FORM OF A SPECIFIC MAP PROJECTION | |
| 542 | C* INPUTS: | |
| 543 | C* TNGLAT - THE LATITUDE AT WHICH THE PROJECTION WILL BE TANGENT | |
| 544 | C* TO THE EARTH. +90. FOR NORTH POLAR STEREOGRAPHIC, | |
| 545 | C* -90. FOR SOUTH POLAR STEREOGRAPHIC, 0. FOR MERCATOR, | |
| 546 | C* AND OTHER VALUES FOR LAMBERT CONFORMAL. | |
| 547 | C* -90 <= TNGLAT <= 90. | |
| 548 | C* CLONG - A LONGITUDE IN THE REGION UNDER CONSIDERATION. LONGITUDES | |
| 549 | C* BETWEEN CLONG-180. AND CLONG+180. WILL BE MAPPED IN ONE | |
| 550 | C* CONNECTED REGION | |
| 551 | C* OUTPUTS: | |
| 552 | C* STRCMP - A 9-VALUE MAP STRUCTURE ARRAY FOR USE WITH SUBSEQUENT | |
| 553 | C* CALLS TO THE COORDINATE TRANSFORM ROUTINES. | |
| 554 | C* | |
| 555 | C* REAL FUNCTION EQVLAT (XLAT1,XLAT2) | |
| 556 | C* THIS FUNCTION IS PROVIDED TO ASSIST IN FINDING THE TANGENT LATITUDE | |
| 557 | C* EQUIVALENT TO THE 2-REFERENCE LATITUDE SPECIFICATION IN THE LEGEND | |
| 558 | C* OF MOST LAMBERT CONFORMAL MAPS. IF THE MAP SPECIFIES "SCALE | |
| 559 | C* 1:XXXXX TRUE AT 40N AND 60N", THEN EQVLAT(40.,60.) WILL RETURN THE | |
| 560 | C* EQUIVALENT TANGENT LATITUDE. | |
| 561 | C* INPUTS: | |
| 562 | C* XLAT1,XLAT2: THE TWO LATITUDES SPECIFIED IN THE MAP LEGEND | |
| 563 | C* RETURNS: | |
| 564 | C* THE EQUIVALENT TANGENT LATITUDE | |
| 565 | C* EXAMPLE: CALL STLMBR(STRCMP, EQVLAT(40.,60.), 90.) | |
| 566 | ||
| 567 | C* SUBROUTINE STCM2P (STRCMP, X1,Y1, XLAT1,XLONG1, | |
| 568 | C* X2,Y2, XLAT2,XLONG2) | |
| 569 | C* SUBROUTINE STCM1P (STRCMP, X1,Y1, XLAT1,XLONG1, | |
| 570 | C* XLATG,XLONGG, GRIDSZ, ORIENT) | |
| 571 | C* THESE ROUTINES COMPLETE THE SPECIFICATION OF THE MAP STRUCTURE | |
| 572 | C* ARRAY BY CONFORMING THE MAP COORDINATES TO THE SPECIFICATIONS | |
| 573 | C* OF A PARTICULAR GRID. EITHER STCM1P OR STCM2P MUST BE CALLED, | |
| 574 | C* BUT NOT BOTH | |
| 575 | C* INPUTS: | |
| 576 | C* STRCMP - A 9-VALUE MAP STRUCTURE ARRAY, SET TO A PARTICULAR MAP | |
| 577 | C* FORM BY A PREVIOUS CALL TO STLMBR | |
| 578 | C* FOR STCM2P: | |
| 579 | C* X1,Y1, X2,Y2 - THE MAP COORDINATES OF TWO POINTS ON THE GRID | |
| 580 | C* XLAT1,XLONG1, XLAT2,XLONG2 - THE GEOGRAPHIC COORDINATES OF THE | |
| 581 | C* SAME TWO POINTS | |
| 582 | C* FOR STCM1P: | |
| 583 | C* X1,Y1 - THE MAP COORDINATES OF ONE POINT ON THE GRID | |
| 584 | C* XLAT1,XLONG1 - THE GEOGRAPHIC COORDINATES OF THE SAME POINT | |
| 585 | C* XLATG,XLONGG - LATITUDE AND LONGITUDE OF REFERENCE POINT FOR | |
| 586 | C* GRIDSZ AND ORIENTATION SPECIFICATION. | |
| 587 | C* GRIDSZ - THE DESIRED GRID SIZE IN KILOMETERS, AT XLATG,XLONGG | |
| 588 | C* ORIENT - THE ANGLE, WITH RESPECT TO NORTH, OF A Y-GRID LINE, AT | |
| 589 | C* THE POINT XLATG,XLONGG | |
| 590 | C* OUTPUTS: | |
| 591 | C* STRCMP - A 9-VALUE MAP STRUCTURE ARRAY, FULLY SET FOR USE BY | |
| 592 | C* OTHER SUBROUTINES IN THIS SYSTEM | |
| 593 | ||
| 594 | C* SUBROUTINE CLL2XY (STRCMP, XLAT,XLONG, X,Y) | |
| 595 | C* SUBROUTINE CXY2LL (STRCMP, X,Y, XLAT,XLONG) | |
| 596 | C* THESE ROUTINES CONVERT BETWEEN MAP COORDINATES X,Y | |
| 597 | C* AND GEOGRAPHIC COORDINATES XLAT,XLONG | |
| 598 | C* INPUTS: | |
| 599 | C* STRCMP(9) - 9-VALUE MAP STRUCTURE ARRAY | |
| 600 | C* FOR CLL2XY: XLAT,XLONG - GEOGRAPHIC COORDINATES | |
| 601 | C* FOR CXY2LL: X,Y - MAP COORDINATES | |
| 602 | C* OUTPUTS: | |
| 603 | C* FOR CLL2XY: X,Y - MAP COORDINATES | |
| 604 | C* FOR CXY2LL: XLAT,XLONG - GEOGRAPHIC COORDINATES | |
| 605 | ||
| 606 | C* SUBROUTINE CC2GXY (STRCMP, X,Y, UE,VN, UG,VG) | |
| 607 | C* SUBROUTINE CG2CXY (STRCMP, X,Y, UG,VG, UE,VN) | |
| 608 | C* SUBROUTINE CC2GLL (STRCMP, XLAT,XLONG, UE,VN, UG,VG) | |
| 609 | C* SUBROUTINE CG2CLL (STRCMP, XLAT,XLONG, UG,VG, UE,VN) | |
| 610 | C* THESE SUBROUTINES CONVERT VECTOR WIND COMPONENTS FROM | |
| 611 | C* GEOGRAPHIC, OR COMPASS, COORDINATES, TO MAP OR | |
| 612 | C* GRID COORDINATES. THE SITE OF THE WIND TO BE | |
| 613 | C* CONVERTED MAY BE GIVEN EITHER IN GEOGRAPHIC OR | |
| 614 | C* MAP COORDINATES. WIND COMPONENTS ARE ALL IN KILOMETERS | |
| 615 | C* PER HOUR, WHETHER GEOGRAPHIC OR MAP COORDINATES. | |
| 616 | C* INPUTS: | |
| 617 | C* STRCMP(9) - 9-VALUE MAP STRUCTURE ARRAY | |
| 618 | C* FOR CC2GXY AND CG2CXY: X,Y - MAP COORDINATES OF SITE | |
| 619 | C* FOR CC2GLL AND CG2CLL: XLAT,XLONG - GEOGRAPHIC COORDINATES OF SITE | |
| 620 | C* FOR CC2GXY AND CC2GLL: UE,VN - EAST AND NORTH WIND COMPONENTS | |
| 621 | C* FOR CG2CXY AND CG2CLL: UG,VG - X- AND Y- DIRECTION WIND COMPONENTS | |
| 622 | C* OUTPUTS: | |
| 623 | C* FOR CC2GXY AND CC2GLL: UG,VG - X- AND Y- DIRECTION WIND COMPONENTS | |
| 624 | C* FOR CG2CXY AND CG2CLL: UE,VN - EAST AND NORTH WIND COMPONENTS | |
| 625 | ||
| 626 | C* SUBROUTINE CCRVXY (STRCMP, X, Y, GX,GY) | |
| 627 | C* SUBROUTINE CCRVLL (STRCMP, XLAT,XLONG, GX,GY) | |
| 628 | C* THESE SUBROUTINES RETURN THE CURVATURE VECTOR (GX,GY), AS REFERENCED | |
| 629 | C* TO MAP COORDINATES, INDUCED BY THE MAP TRANSFORMATION. WHEN | |
| 630 | C* NON-LINEAR TERMS IN WIND SPEED ARE IMPORTANT, A "GEODESIC" FORCE | |
| 631 | C* SHOULD BE INCLUDED IN THE VECTOR FORM [ (U,U) G - (U,G) U ] WHERE THE | |
| 632 | C* INNER PRODUCT (U,G) IS DEFINED AS UX*GX + UY*GY. | |
| 633 | C* INPUTS: | |
| 634 | C* STRCMP(9) - 9-VALUE MAP STRUCTURE ARRAY | |
| 635 | C* FOR CCRVXY: X,Y - MAP COORDINATES OF SITE | |
| 636 | C* FOR CCRVLL: XLAT,XLONG - GEOGRAPHIC COORDINATES OF SITE | |
| 637 | C* OUTPUTS: | |
| 638 | C* GX,GY - VECTOR COEFFICIENTS OF CURVATURE, IN UNITS RADIANS | |
| 639 | C* PER KILOMETER | |
| 640 | ||
| 641 | C* REAL FUNCTION CGSZLL (STRCMP, XLAT,XLONG) | |
| 642 | C* REAL FUNCTION CGSZXY (STRCMP, X,Y) | |
| 643 | C* THESE FUNCTIONS RETURN THE SIZE, IN KILOMETERS, OF EACH UNIT OF | |
| 644 | C* MOTION IN MAP COORDINATES (GRID SIZE). THE GRID SIZE AT ANY | |
| 645 | C* LOCATION DEPENDS ON THAT LOCATION; THE POSITION MAY BE GIVEN IN | |
| 646 | C* EITHER MAP OR GEOGRAPHIC COORDINATES. | |
| 647 | C* INPUTS: | |
| 648 | C* STRCMP(9) - 9-VALUE MAP STRUCTURE ARRAY | |
| 649 | C* FOR CGSZXY: X,Y - MAP COORDINATES OF SITE | |
| 650 | C* FOR CGSZLL: XLAT,XLONG - GEOGRAPHIC COORDINATES OF SITE | |
| 651 | C* RETURNS: | |
| 652 | C* GRIDSIZE IN KILOMETERS AT GIVEN SITE. | |
| 653 | ||
| 654 | C* SUBROUTINE CPOLXY (STRCMP, X,Y, ENX,ENY,ENZ) | |
| 655 | C* SUBROUTINE CPOLLL (STRCMP, XLAT,XLONG, ENX,ENY,ENZ) | |
| 656 | C* THESE SUBROUTINES PROVIDE 3-D VECTOR COMPONENTS OF A UNIT VECTOR | |
| 657 | C* IN THE DIRECTION OF THE NORTH POLAR AXIS. WHEN MULTIPLIED | |
| 658 | C* BY TWICE THE ROTATION RATE OF THE EARTH (2 * PI/24 HR), THE | |
| 659 | C* VERTICAL COMPONENT YIELDS THE CORIOLIS FACTOR. | |
| 660 | C* INPUTS: | |
| 661 | C* STRCMP(9) - 9-VALUE MAP STRUCTURE ARRAY | |
| 662 | C* FOR CPOLXY: X,Y - MAP COORDINATES OF SITE | |
| 663 | C* FOR CPOLLL: XLAT,XLONG - GEOGRAPHIC COORDINATES OF SITE | |
| 664 | C* RETURNS: | |
| 665 | C* ENX,ENY,ENZ THE DIRECTION COSINES OF A UNIT VECTOR IN THE | |
| 666 | C* DIRECTION OF THE ROTATION AXIS OF THE EARTH | |
| 667 | ||
| 668 | C* SUBROUTINE CNLLXY (STRCMP, XLAT,XLONG, XI,ETA) | |
| 669 | C* SUBROUTINE CNXYLL (STRCMP, XI,ETA, XLAT,XLONG) | |
| 670 | C* THESE SUBROUTINES PERFORM THE UNDERLYING TRANSFORMATIONS FROM | |
| 671 | C* GEOGRAPHIC COORDINATES TO AND FROM CANONICAL (EQUATOR CENTERED) | |
| 672 | C* COORDINATES. THEY ARE CALLED BY CXY2LL AND CLL2XY, BUT ARE NOT | |
| 673 | C* INTENDED TO BE CALLED DIRECTLY | |
| 674 | ||
| 675 | C* REAL FUNCTION CSPANF (VALUE, BEGIN, END) | |
| 676 | C* THIS FUNCTION ASSISTS OTHER ROUTINES IN PROVIDING A LONGITUDE IN | |
| 677 | C* THE PROPER RANGE. IT ADDS TO VALUE WHATEVER MULTIPLE OF | |
| 678 | C* (END - BEGIN) IS NEEDED TO RETURN A NUMBER BEGIN < CSPANF <= END | |
| 679 | ||
| 680 | SUBROUTINE STLMBR(STRCMP, TNGLAT, XLONG) | |
| 681 | C* WRITTEN ON 3/31/94 BY Dr. Albion Taylor NOAA / OAR / ARL | |
| 682 | PARAMETER (PI=3.14159265358979,RADPDG=PI/180,DGPRAD=180/PI) | |
| 683 | PARAMETER (REARTH=6 371.2) | |
| 684 | REAL STRCMP(9) | |
| 685 | STRCMP(1) = SIN(RADPDG * TNGLAT) | |
| 686 | C* GAMMA = SINE OF THE TANGENT LATITUDE | |
| 687 | STRCMP(2) = CSPANF( XLONG, -180., +180.) | |
| 688 | C* LAMBDA_0 = REFERENCE LONGITUDE | |
| 689 | STRCMP(3) = 0. | |
| 690 | C* X_0 = X- GRID COORDINATE OF ORIGIN (XI,ETA) = (0.,0.) | |
| 691 | STRCMP(4) = 0. | |
| 692 | C* y_0 = Y-GRID COORDINATE OF ORIGIN (XI,ETA) = (0.,0.) | |
| 693 | STRCMP(5) = 1. | |
| 694 | C* COSINE OF ROTATION ANGLE FROM XI,ETA TO X,Y | |
| 695 | STRCMP(6) = 0. | |
| 696 | C* SINE OF ROTATION ANGLE FROM XI,ETA TO X,Y | |
| 697 | STRCMP(7) = REARTH | |
| 698 | C* GRIDSIZE IN KILOMETERS AT THE EQUATOR | |
| 699 | CALL CNLLXY(STRCMP, 89.,XLONG, XI,ETA) | |
| 700 | STRCMP(8) = 2. * ETA - STRCMP(1) * ETA * ETA | |
| 701 | C* RADIAL COORDINATE FOR 1 DEGREE FROM NORTH POLE | |
| 702 | CALL CNLLXY(STRCMP, -89.,XLONG, XI,ETA) | |
| 703 | STRCMP(9) = 2. * ETA - STRCMP(1) * ETA * ETA | |
| 704 | C* RADIAL COORDINATE FOR 1 DEGREE FROM SOUTH POLE | |
| 705 | RETURN | |
| 706 | END |
| 0 | subroutine coordtrafo(error) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE COORDTRAFO * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1994-02-07 * | |
| 9 | * LAST UPDATE: ---------- * | |
| 10 | * * | |
| 11 | *********************************************************************** | |
| 12 | * * | |
| 13 | * DESCRIPTION: This subroutine transforms x and y coordinates of * | |
| 14 | * trajectory starting points to grid coordinates. * | |
| 15 | * * | |
| 16 | *********************************************************************** | |
| 17 | * | |
| 18 | include 'includepar' | |
| 19 | include 'includecom' | |
| 20 | ||
| 21 | integer i,j | |
| 22 | logical error | |
| 23 | ||
| 24 | error=.false. | |
| 25 | ||
| 26 | if(numpoint.eq.0) goto 30 | |
| 27 | * | |
| 28 | * TRANSFORM X- AND Y- COORDINATES OF STARTING POINTS TO GRID COORDINATES | |
| 29 | * | |
| 30 | ||
| 31 | do 10 i=1,numpoint | |
| 32 | xpoint(i)=(xpoint(i)-xlon0)/dx | |
| 33 | if (xglobal) then | |
| 34 | if (xpoint(i).gt.float(nx-1)) xpoint(i)=xpoint(i)-float(nx-1) | |
| 35 | if (xpoint(i).lt.0.) xpoint(i)=xpoint(i)+float(nx-1) | |
| 36 | endif | |
| 37 | 10 ypoint(i)=(ypoint(i)-ylat0)/dy | |
| 38 | ||
| 39 | 15 continue | |
| 40 | * | |
| 41 | * CHECK IF STARTING POINTS ARE WITHIN DOMAIN | |
| 42 | * | |
| 43 | do 25 i=1,numpoint | |
| 44 | ||
| 45 | if((xpoint(i).lt.0.).or.(xpoint(i).gt.float(nx-1)).or. | |
| 46 | & (ypoint(i).lt.0.).or.(ypoint(i).gt.float(ny-1))) then | |
| 47 | ||
| 48 | write(*,*) ' NOTICE: STARTING POINT OUT OF DOMAIN HAS '// | |
| 49 | & 'BEEN DETECTED --> ' | |
| 50 | write(*,*) ' IT IS REMOVED NOW ... ' | |
| 51 | write(*,*) ' COMMENT: ',compoint(i) | |
| 52 | ||
| 53 | if(i.lt.numpoint) then | |
| 54 | ||
| 55 | do 20 j=i+1,numpoint | |
| 56 | ||
| 57 | xpoint(j-1)=xpoint(j) | |
| 58 | ypoint(j-1)=ypoint(j) | |
| 59 | zpoint(j-1)=zpoint(j) | |
| 60 | kind(j-1)=kind(j) | |
| 61 | kindz(j-1)=kindz(j) | |
| 62 | 20 compoint(j-1)=compoint(j) | |
| 63 | ||
| 64 | endif | |
| 65 | ||
| 66 | numpoint=numpoint-1 | |
| 67 | if(numpoint.gt.0) goto 15 | |
| 68 | ||
| 69 | endif | |
| 70 | ||
| 71 | 25 continue | |
| 72 | ||
| 73 | 30 if(numpoint.eq.0) then | |
| 74 | ||
| 75 | error=.true. | |
| 76 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE COORDTRAFO: '// | |
| 77 | & 'ERROR ! ' | |
| 78 | write(*,*) ' NO TRAJECTORY STARTING POINTS ARE GIVEN !!!' | |
| 79 | ||
| 80 | endif | |
| 81 | ||
| 82 | return | |
| 83 | end |
| 0 | real function eta(psurf,pconst) | |
| 1 | ****************************************************************************** | |
| 2 | * * | |
| 3 | * This routine computes vertical coordinate eta for a given pressure p. * | |
| 4 | * * | |
| 5 | * Author: A. Stohl * | |
| 6 | * * | |
| 7 | * 5 April 1994 * | |
| 8 | * Last modification: G. Wotawa, 1994 - 04 -27 * | |
| 9 | * * | |
| 10 | ****************************************************************************** | |
| 11 | * Variables: * | |
| 12 | * eta value of eta for given pressure * | |
| 13 | * fract help variable for linear interpolation * | |
| 14 | * plevel1 [Pa] pressure of level below wanted pressure * | |
| 15 | * plevel2 [Pa] pressure of level above wanted pressure * | |
| 16 | * pconst [Pa] pressure level of isobaric trajectory * | |
| 17 | * psurf [Pa] surface level pressure * | |
| 18 | * wheight(nwzmax) height of ecmwf layer interfaces (eta coordinates) * | |
| 19 | ****************************************************************************** | |
| 20 | ||
| 21 | include 'includepar' | |
| 22 | include 'includecom' | |
| 23 | ||
| 24 | integer i | |
| 25 | real plevel1,plevel2,fract,psurf,pconst | |
| 26 | ||
| 27 | plevel1=akm(1)+bkm(1)*psurf | |
| 28 | if (plevel1.le.pconst) then ! pressure higher than surface pressure | |
| 29 | eta=wheight(1) | |
| 30 | else ! normal case -> linear interpolation | |
| 31 | do 10 i=2,nwz ! look, between which layers we are | |
| 32 | plevel2=akm(i)+bkm(i)*psurf | |
| 33 | if (plevel2.lt.pconst) then | |
| 34 | fract=(pconst-plevel2)/(plevel1-plevel2) | |
| 35 | eta=wheight(i)*(1.-fract)+wheight(i-1)*fract | |
| 36 | goto 100 | |
| 37 | endif | |
| 38 | 10 plevel1=plevel2 | |
| 39 | eta=wheight(nwz) ! pressure lower than highest model layer | |
| 40 | endif | |
| 41 | ||
| 42 | 100 continue | |
| 43 | ||
| 44 | ||
| 45 | if (eta.gt.heightmax) eta=heightmax | |
| 46 | if (eta.lt.heightmin) eta=heightmin | |
| 47 | ||
| 48 | return | |
| 49 | end |
| 0 | subroutine etatrafo(xt,yt,zt,itime1,itime2,itime,indexf,ngrid, | |
| 1 | +psint) | |
| 2 | *********************************************************************** | |
| 3 | * * | |
| 4 | * TRAJECTORY MODEL SUBROUTINE ETATRAFO * | |
| 5 | * * | |
| 6 | *********************************************************************** | |
| 7 | * * | |
| 8 | * AUTHOR: G. WOTAWA * | |
| 9 | * DATE: 1994-04-06 * | |
| 10 | * LAST UPDATE: ---------- * | |
| 11 | * * | |
| 12 | *********************************************************************** | |
| 13 | * * | |
| 14 | * DESCRIPTION: This subroutine transforms the vertical coordinate * | |
| 15 | * from z-coordinate system [m] to eta-coordinate * | |
| 16 | * system [ECMWF] * | |
| 17 | * Remark: Just call after initialization of a new * | |
| 18 | * trajectory (first call of getwind) * | |
| 19 | * * | |
| 20 | *********************************************************************** | |
| 21 | * * | |
| 22 | * INPUT: * | |
| 23 | * * | |
| 24 | * xt x-coordinate of point [grid units] * | |
| 25 | * yt y-coordinate of point [grid units] * | |
| 26 | * zt z-coordinate of point [m] * | |
| 27 | * itime1 time [s] of first windfield * | |
| 28 | * itime2 time [s] of second windfield * | |
| 29 | * itime time [s] of calculation * | |
| 30 | * indexf time index of field xx * | |
| 31 | * psint surface pressure at point (xt,yt) [Pa] * | |
| 32 | * * | |
| 33 | *********************************************************************** | |
| 34 | * * | |
| 35 | * OUTPUT: * | |
| 36 | * * | |
| 37 | * zt z-coordinate of point [eta ECMWF] * | |
| 38 | * * | |
| 39 | *********************************************************************** | |
| 40 | * | |
| 41 | include 'includepar' | |
| 42 | include 'includecom' | |
| 43 | ||
| 44 | integer itime1,itime2,itime,indexf,k,ngrid | |
| 45 | real xt,yt,zt,psint,fract,pp1,pp2,tv | |
| 46 | real tlev(nuvzmax),zzlev(nwzmax) | |
| 47 | * | |
| 48 | * calculate interpolated vertical temperature profile on model levels | |
| 49 | * | |
| 50 | do 10 k=1,nuvz | |
| 51 | if (ngrid.gt.0) then | |
| 52 | call levlininterpoln(ttn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 53 | + nxn,nyn,memind,xt,yt,k,itime1,itime2,itime,indexf,tlev(k)) | |
| 54 | else | |
| 55 | call levlininterpol(tt,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 56 | + xt,yt,k,itime1,itime2,itime,indexf,tlev(k)) | |
| 57 | endif | |
| 58 | 10 continue | |
| 59 | * | |
| 60 | * calculate geometric height on model levels | |
| 61 | * | |
| 62 | zzlev(1)=0. | |
| 63 | if (zt.lt.zzlev(1)) then | |
| 64 | write(*,*) ' TRAJECTORY MODEL: NOTICE - STARTING POINT OUT'// | |
| 65 | & ' OF MODEL DOMAIN' | |
| 66 | write(*,*) ' (VERTICAL) HAS BEEN DETECTED --> IT IS SET TO'// | |
| 67 | & ' THE BOTTOM OF THE MODEL ...' | |
| 68 | zt=uvheight(1) | |
| 69 | return | |
| 70 | endif | |
| 71 | do 15 k=2,nwz | |
| 72 | pp1=akm(k-1)+bkm(k-1)*psint | |
| 73 | pp2=akm(k)+bkm(k)*psint | |
| 74 | tv=tlev(k-1) !! NO HUMIDITY INFORMATION AVAILABLE IN FLEXTRA | |
| 75 | zzlev(k)=zzlev(k-1)+r_air/ga*log(pp1/pp2)*tv | |
| 76 | if(zt.lt.zzlev(k)) goto 20 | |
| 77 | 15 continue | |
| 78 | write(*,*) ' TRAJECTORY MODEL: NOTICE - STARTING POINT OUT'// | |
| 79 | & ' OF MODEL DOMAIN' | |
| 80 | write(*,*) ' (VERTICAL) HAS BEEN DETECTED --> IT IS SET TO'// | |
| 81 | & ' THE TOP OF THE MODEL ...' | |
| 82 | zt=uvheight(nuvz) | |
| 83 | return | |
| 84 | 20 fract=(zt-zzlev(k-1))/(zzlev(k)-zzlev(k-1)) | |
| 85 | zt=wheight(k-1)*(1.-fract)+wheight(k)*fract | |
| 86 | if(zt.lt.uvheight(1)) zt=uvheight(1) | |
| 87 | if(zt.gt.uvheight(nuvz)) zt=uvheight(nuvz) | |
| 88 | return | |
| 89 | end |
| 0 | REAL FUNCTION EW(X) | |
| 1 | C **************************************************************** | |
| 2 | C SAETTIGUNGSDAMPFDRUCK UEBER WASSER IN PA. X IN KELVIN. | |
| 3 | C NACH DER GOFF-GRATCH-FORMEL. | |
| 4 | C **************************************************************** | |
| 5 | EW=0. | |
| 6 | IF(X.LE.0.) then | |
| 7 | WRITE(*,*) 'TEMP: ',X | |
| 8 | STOP 'SORRY: T NOT IN [K]' | |
| 9 | ENDIF | |
| 10 | Y=373.16/X | |
| 11 | A=-7.90298*(Y-1.) | |
| 12 | A=A+(5.02808*0.43429*ALOG(Y)) | |
| 13 | C=(1.-(1./Y))*11.344 | |
| 14 | C=-1.+(10.**C) | |
| 15 | C=-1.3816*C/(10.**7) | |
| 16 | D=(1.-Y)*3.49149 | |
| 17 | D=-1.+(10.**D) | |
| 18 | D=8.1328*D/(10.**3) | |
| 19 | Y=A+C+D | |
| 20 | EW=1013.246*(10.**Y)*100. ! Saettigungsdampfdruck in Pa | |
| 21 | RETURN | |
| 22 | END |
| 0 | subroutine geteta(xt,yt,eta,theta,itime1,itime2,itime,indexf, | |
| 1 | +psurf,ngrid,indz1,indz2) | |
| 2 | C i i i/o i i i i i | |
| 3 | C i i o o | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Calculates eta for a given potential temperature. * | |
| 7 | * If profile is unstable, an eta region is given instead of a single * | |
| 8 | * level. * | |
| 9 | * * | |
| 10 | * Author: A. Stohl * | |
| 11 | * * | |
| 12 | * 27 April 1994 * | |
| 13 | * * | |
| 14 | * Modified by Petra Seibert, 27 April 1995: * | |
| 15 | * indz1 and indz2 will contain indz on output instead of 1 * | |
| 16 | * in stable case * | |
| 17 | * * | |
| 18 | ***************************************************************************** | |
| 19 | * * | |
| 20 | * Variables: * | |
| 21 | * akz,bkz(nuvzmax) coefficients for computing the heights of the eta lev* | |
| 22 | * deltazt vertical displacement of trajectory in eta coordinate* | |
| 23 | * dt,dt1,dt2 weighting factors * | |
| 24 | * eta old eta level of isentropic trajectory * | |
| 25 | * indexf indicates the number of the wind field to be read in * | |
| 26 | * indz1,indz2 indices of layer boundaries of unstable region * | |
| 27 | * itime time index of trajectory position * | |
| 28 | * itime1 time index of first temperature field * | |
| 29 | * itime2 time index of second temperature field * | |
| 30 | * ngrid level of nested grid to be used * | |
| 31 | * nx,ny,nuvz field dimensions in x,y and z for (u,v) direction * | |
| 32 | * pp(nuvzmax) [Pa] Pressure at the model levels * | |
| 33 | * psurf [Pa] Surface pressure * | |
| 34 | * theta [K] theta level of trajectory calculation * | |
| 35 | * tt(0:nxmax-1,0:nymax-1,nuvzmax,3) 3-dim temperature field * | |
| 36 | * ttlev(nuvzmax) [K] Potential temperature at the model levels * | |
| 37 | * xt,yt Position of trajectory * | |
| 38 | * * | |
| 39 | * Constants: * | |
| 40 | * kappa exponent for calculating potential temperature * | |
| 41 | * nuvzmax maximum number of levels, where u,v and tt are given * | |
| 42 | * * | |
| 43 | ***************************************************************************** | |
| 44 | ||
| 45 | include 'includepar' | |
| 46 | include 'includecom' | |
| 47 | ||
| 48 | integer itime,itime1,itime2,indexf,k,indz,indz1,indz2,i,ngrid | |
| 49 | real xt,yt,zt,theta,zthelp,dt,dt1,dt2,deltazt,eta,thelp | |
| 50 | real psurf,pp(nuvzmax),ttlev(nuvzmax) | |
| 51 | ||
| 52 | ||
| 53 | ********************************************* | |
| 54 | C 1. Calculate the pressure at all eta levels | |
| 55 | ********************************************* | |
| 56 | ||
| 57 | do 10 k=1,nuvz | |
| 58 | 10 pp(k)=akz(k)+bkz(k)*psurf | |
| 59 | ||
| 60 | ||
| 61 | ************************************************ | |
| 62 | C 2. Calculate the temperature at all eta levels | |
| 63 | ************************************************ | |
| 64 | ||
| 65 | do 16 k=1,nuvz | |
| 66 | if (ngrid.gt.0) then | |
| 67 | call levlininterpoln(ttn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 68 | + nxn,nyn,memind,xt,yt,k,itime1,itime2,itime,indexf,ttlev(k)) | |
| 69 | else | |
| 70 | call levlininterpol(tt,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 71 | + xt,yt,k,itime1,itime2,itime,indexf,ttlev(k)) | |
| 72 | endif | |
| 73 | 16 continue | |
| 74 | ||
| 75 | ||
| 76 | ********************************************************** | |
| 77 | C 3. Calculate the potential temperature at all eta levels | |
| 78 | ********************************************************** | |
| 79 | ||
| 80 | do 20 k=1,nuvz | |
| 81 | 20 ttlev(k)=ttlev(k)*(100000/pp(k))**kappa | |
| 82 | ||
| 83 | ***************************************************************************** | |
| 84 | C 4. Search for the potential temperature that is equal to the temperature of | |
| 85 | C trajectory calculation. If the region where this temperature can be found | |
| 86 | C is unstable, find the lower and upper boundary of the unstable region. | |
| 87 | ***************************************************************************** | |
| 88 | ||
| 89 | C Find the height where potential temp. is equal to trajectory level. | |
| 90 | C If more levels exist, where this is valid, search for the one | |
| 91 | C closest in eta coordinate to the eta coordinate of last time step. | |
| 92 | ********************************************************************* | |
| 93 | ||
| 94 | deltazt=999999. | |
| 95 | do 30 k=1,nuvz-1 | |
| 96 | if (((ttlev(k).ge.theta).and.(ttlev(k+1).le.theta)).or. | |
| 97 | + ((ttlev(k).le.theta).and.(ttlev(k+1).ge.theta))) then | |
| 98 | dt1=abs(theta-ttlev(k)) | |
| 99 | dt2=abs(theta-ttlev(k+1)) | |
| 100 | dt=dt1+dt2 | |
| 101 | if (dt.lt.eps) then ! Avoid division by zero error | |
| 102 | dt1=0.5 ! G.W., 10.4.1996 | |
| 103 | dt2=0.5 | |
| 104 | dt=1.0 | |
| 105 | endif | |
| 106 | zthelp=(uvheight(k)*dt2+uvheight(k+1)*dt1)/dt | |
| 107 | if (abs(zthelp-eta).lt.deltazt) then | |
| 108 | deltazt=abs(zthelp-eta) | |
| 109 | zt=zthelp | |
| 110 | indz=k | |
| 111 | endif | |
| 112 | endif | |
| 113 | 30 continue | |
| 114 | ||
| 115 | ||
| 116 | if (deltazt.gt.999990.) then ! no level has been found | |
| 117 | if (abs(ttlev(1)-theta).lt.abs(ttlev(nuvz)-theta)) then | |
| 118 | indz=1 | |
| 119 | zt=uvheight(1) | |
| 120 | else | |
| 121 | indz=nuvz-1 | |
| 122 | zt=uvheight(nuvz) | |
| 123 | endif | |
| 124 | endif | |
| 125 | ||
| 126 | ||
| 127 | C Determine if the air at trajectory level is stable or unstable stratified | |
| 128 | C If it is stable -> just take the level | |
| 129 | C If it is unstable -> take the whole unstable region and determine lower | |
| 130 | C and upper boundary of this region | |
| 131 | *************************************************************************** | |
| 132 | ||
| 133 | if (ttlev(indz).lt.ttlev(indz+1)) then ! stable region | |
| 134 | eta=zt | |
| 135 | indz1=indz | |
| 136 | indz2=indz1 ! -----, indz1 and indz2 must be equal | |
| 137 | else ! unstable region | |
| 138 | indz1=1 | |
| 139 | do 40 k=indz-1,1,-1 | |
| 140 | if (ttlev(k).lt.ttlev(k+1)) then | |
| 141 | indz1=k+1 ! lower boundary of unstable region | |
| 142 | thelp=ttlev(indz1) | |
| 143 | goto 45 | |
| 144 | endif | |
| 145 | 40 continue | |
| 146 | 45 continue | |
| 147 | indz2=indz+1 | |
| 148 | do 50 k=indz+2,nuvz | |
| 149 | if (ttlev(k).gt.ttlev(indz1)) then | |
| 150 | indz2=k-1 ! upper boundary of unstable region | |
| 151 | goto 55 | |
| 152 | endif | |
| 153 | 50 continue | |
| 154 | 55 continue | |
| 155 | eta=uvheight(indz2) | |
| 156 | ||
| 157 | ||
| 158 | C Calculate new mean potential temperature of the unstable layer | |
| 159 | **************************************************************** | |
| 160 | ||
| 161 | theta=0. | |
| 162 | do 60 i=indz1,indz2 | |
| 163 | 60 theta=theta+ttlev(i) | |
| 164 | theta=theta/float(indz2-indz1+1) | |
| 165 | endif | |
| 166 | ||
| 167 | ||
| 168 | return | |
| 169 | end |
| 0 | subroutine getfields(firststep,itime,indexf,idiff,nstop) | |
| 1 | C i i o o o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This subroutine manages the 3 data fields to be kept in memory. * | |
| 5 | * During the first time step of petterssen it has to be fulfilled that the * | |
| 6 | * first data field must have |wftime|<itime, i.e. the absolute value of wftime* | |
| 7 | * must be smaller than the absolute value of the current time in [s]. * | |
| 8 | * The other 2 fields are the next in time after the first one. * | |
| 9 | * Pointers (memind) are used, because otherwise one would have to resort the * | |
| 10 | * wind fields, which costs a lot of computing time. Here only the pointers are* | |
| 11 | * resorted. * | |
| 12 | * * | |
| 13 | * Author: A. Stohl * | |
| 14 | * * | |
| 15 | * 29 April 1994 * | |
| 16 | * * | |
| 17 | ******************************************************************************** | |
| 18 | * * | |
| 19 | * Variables: * | |
| 20 | * firststep .true. for first time step of petterssen, else .false. * | |
| 21 | * idiff [s] time difference between the two wind fieldse read in * | |
| 22 | * indj indicates the number of the wind field to be read in * | |
| 23 | * indmin remembers the number of wind fields already treated * | |
| 24 | * memind(3) pointer, on which place the wind fields are stored * | |
| 25 | * memtime(3) [s] times of the wind fields, which are kept in memory * | |
| 26 | * itime [s] current time since start date of trajectory calculation * | |
| 27 | * ldirect 1 for forward trajectories, -1 for backward trajectories* | |
| 28 | * nstop > 0, if trajectory has to be terminated * | |
| 29 | * nx,ny,nuvz,nwz field dimensions in x,y and z direction * | |
| 30 | * uu(0:nxmax-1,0:nymax-1,nuvzmax,3) wind components in x-direction [m/s] * | |
| 31 | * vv(0:nxmax-1,0:nymax-1,nuvzmax,3) wind components in y-direction [m/s] * | |
| 32 | * ww(0:nxmax-1,0:nymax-1,nwzmax,3)wind components in z-direction [deltaeta/s] * | |
| 33 | * tt(0:nxmax-1,0:nymax-1,nuvzmax,3) temperature [K] * | |
| 34 | * ps(0:nxmax-1,0:nymax-1,3) surface pressure [Pa] * | |
| 35 | * * | |
| 36 | * Constants: * | |
| 37 | * idiffnorm normal time difference between 2 wind fields * | |
| 38 | * idiffmax maximum allowable time difference between 2 wind fields * | |
| 39 | * * | |
| 40 | ******************************************************************************** | |
| 41 | ||
| 42 | include 'includepar' | |
| 43 | include 'includecom' | |
| 44 | ||
| 45 | integer indj,indmin,l,itime,indexf,idiff,nstop,memhelp | |
| 46 | logical firststep | |
| 47 | save indmin | |
| 48 | ||
| 49 | data indmin/1/ | |
| 50 | ||
| 51 | ||
| 52 | C Check, if wind fields are available for the current time step | |
| 53 | *************************************************************** | |
| 54 | ||
| 55 | if ((ldirect*wftime(1).ge.ldirect*itime).or. | |
| 56 | +(ldirect*wftime(numbwf).le.ldirect*itime)) then | |
| 57 | write(*,*) 'FLEXTRA WARNING: NO WIND FIELDS ARE AVAILABLE.' | |
| 58 | write(*,*) 'A TRAJECTORY HAS TO BE TERMINATED.' | |
| 59 | nstop=4 | |
| 60 | return | |
| 61 | endif | |
| 62 | ||
| 63 | ||
| 64 | ****************************************************************************** | |
| 65 | C For the first time step of petterssen, arrange the wind fields in such a way | |
| 66 | C that 1st wind field is before itime and 2nd and 3rd are after itime. | |
| 67 | ****************************************************************************** | |
| 68 | ||
| 69 | if (firststep) then | |
| 70 | if ((ldirect*memtime(1).lt.ldirect*itime).and. | |
| 71 | + (ldirect*memtime(2).ge.ldirect*itime)) then | |
| 72 | ||
| 73 | C The right wind fields are already in memory -> don't do anything | |
| 74 | ****************************************************************** | |
| 75 | ||
| 76 | continue | |
| 77 | ||
| 78 | else if ((ldirect*memtime(2).lt.ldirect*itime).and. | |
| 79 | + (ldirect*memtime(3).ge.ldirect*itime)) then | |
| 80 | ||
| 81 | ||
| 82 | C Current time is between 2nd and 3rd wind field | |
| 83 | C -> Resort wind field pointers, so that current time is between 1st and 2nd | |
| 84 | **************************************************************************** | |
| 85 | ||
| 86 | memhelp=memind(1) | |
| 87 | do 10 l=1,2 | |
| 88 | memind(l)=memind(l+1) | |
| 89 | 10 memtime(l)=memtime(l+1) | |
| 90 | memind(3)=memhelp | |
| 91 | ||
| 92 | ||
| 93 | C Read a new wind field and store it on place memind(3) | |
| 94 | ******************************************************* | |
| 95 | ||
| 96 | do 30 indj=indmin,numbwf-2 | |
| 97 | if ((ldirect*wftime(indj).lt.ldirect*itime).and. | |
| 98 | + (ldirect*wftime(indj+1).ge.ldirect*itime)) then | |
| 99 | call readwind(indj+2,memind(3)) | |
| 100 | call readwind_nests(indj+2,memind(3)) | |
| 101 | memtime(3)=wftime(indj+2) | |
| 102 | goto 40 | |
| 103 | endif | |
| 104 | 30 continue | |
| 105 | 40 indmin=indj | |
| 106 | ||
| 107 | else | |
| 108 | ||
| 109 | C No wind fields, which can be used, are currently in memory | |
| 110 | C -> read all 3 wind fields | |
| 111 | ************************************************************ | |
| 112 | ||
| 113 | do 50 indj=indmin,numbwf-1 | |
| 114 | if ((ldirect*wftime(indj).lt.ldirect*itime).and. | |
| 115 | + (ldirect*wftime(indj+1).ge.ldirect*itime)) then | |
| 116 | memind(1)=1 | |
| 117 | call readwind(indj,memind(1)) | |
| 118 | call readwind_nests(indj,memind(1)) | |
| 119 | memtime(1)=wftime(indj) | |
| 120 | memind(2)=2 | |
| 121 | call readwind(indj+1,memind(2)) | |
| 122 | call readwind_nests(indj+1,memind(2)) | |
| 123 | memtime(2)=wftime(indj+1) | |
| 124 | memind(3)=3 | |
| 125 | call readwind(indj+2,memind(3)) | |
| 126 | call readwind_nests(indj+2,memind(3)) | |
| 127 | memtime(3)=wftime(indj+2) | |
| 128 | goto 60 | |
| 129 | endif | |
| 130 | 50 continue | |
| 131 | 60 indmin=indj | |
| 132 | ||
| 133 | endif | |
| 134 | ||
| 135 | indexf=1 | |
| 136 | idiff=abs(memtime(2)-memtime(1)) | |
| 137 | ||
| 138 | ||
| 139 | ***************************************************************************** | |
| 140 | C For 2nd step of petterssen all necessary data fields are already in memory. | |
| 141 | C Just look, if current temporal position is between the first two fields or | |
| 142 | C between the 2nd and 3rd field. | |
| 143 | ***************************************************************************** | |
| 144 | ||
| 145 | else | |
| 146 | if ((ldirect*memtime(1).lt.ldirect*itime).and. !between 1st and 2nd | |
| 147 | + (ldirect*memtime(2).ge.ldirect*itime)) then | |
| 148 | indexf=1 | |
| 149 | idiff=abs(memtime(2)-memtime(1)) | |
| 150 | else if ((ldirect*memtime(2).lt.ldirect*itime).and. !between 2nd and 3rd | |
| 151 | + (ldirect*memtime(3).ge.ldirect*itime)) then | |
| 152 | indexf=2 | |
| 153 | idiff=abs(memtime(3)-memtime(2)) | |
| 154 | endif | |
| 155 | endif | |
| 156 | ||
| 157 | C Check the time difference between the wind fields. If it is too | |
| 158 | C big, terminate the trajectory. | |
| 159 | ****************************************************************** | |
| 160 | ||
| 161 | if (idiff.gt.idiffmax) nstop=3 | |
| 162 | ||
| 163 | return | |
| 164 | end |
| 0 | subroutine getheight(itime,xt,yt,zt,pt,ht) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE GETHEIGHT * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1994-04-07 * | |
| 9 | * Adaptation to Nesting: A. Stohl, 1999-01-07 * | |
| 10 | * More efficient determination of wind field index, * | |
| 11 | * A. Stohl, 2000-01-30 * | |
| 12 | *********************************************************************** | |
| 13 | * * | |
| 14 | * DESCRIPTION: This subroutine calculates pressure [Pa] and geometric * | |
| 15 | * height [m] along trajectory for a given vertical * | |
| 16 | * coordinate zt (eta ECMWF) on a given position (xt,yt). * | |
| 17 | * * | |
| 18 | *********************************************************************** | |
| 19 | * * | |
| 20 | * INPUT: * | |
| 21 | * * | |
| 22 | * itime time relative to beginning of calculation period * | |
| 23 | * xt x coordinate of point [grid units] * | |
| 24 | * yt y coordinate of point [grid units] * | |
| 25 | * zt z coordinate of point [units] * | |
| 26 | * * | |
| 27 | *********************************************************************** | |
| 28 | * * | |
| 29 | * OUTPUT: * | |
| 30 | * * | |
| 31 | * pt pressure [Pa] * | |
| 32 | * ht geometric height [m] * | |
| 33 | * * | |
| 34 | *********************************************************************** | |
| 35 | * | |
| 36 | include 'includepar' | |
| 37 | include 'includecom' | |
| 38 | ||
| 39 | integer itime,indexf,j,ngrid | |
| 40 | ||
| 41 | real pp,xt,yt,zt,pt,ht,psint,xtn,ytn | |
| 42 | ||
| 43 | ||
| 44 | C Determine the times of the wind fields needed for interpolation | |
| 45 | ****************************************************************** | |
| 46 | ||
| 47 | if ((ldirect*memtime(1).lt.ldirect*itime).and. | |
| 48 | +(ldirect*memtime(2).ge.ldirect*itime)) then ! between 1st and 2nd | |
| 49 | indexf=1 | |
| 50 | else if((ldirect*memtime(2).lt.ldirect*itime).and. | |
| 51 | +(ldirect*memtime(3).ge.ldirect*itime)) then ! between 2nd and 3rd | |
| 52 | indexf=2 | |
| 53 | endif | |
| 54 | ||
| 55 | ||
| 56 | C Determine which nesting level to be used | |
| 57 | ****************************************** | |
| 58 | ||
| 59 | ngrid=0 | |
| 60 | do 12 j=numbnests,1,-1 | |
| 61 | if ((xt.gt.xln(j)).and.(xt.lt.xrn(j)).and. | |
| 62 | + (yt.gt.yln(j)).and.(yt.lt.yrn(j))) then | |
| 63 | ngrid=j | |
| 64 | goto 13 | |
| 65 | endif | |
| 66 | 12 continue | |
| 67 | 13 continue | |
| 68 | ||
| 69 | if (ngrid.eq.0) then | |
| 70 | xtn=xt | |
| 71 | ytn=yt | |
| 72 | call levlininterpol(ps,nxmax,nymax,1,nx,ny,memind, | |
| 73 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime,indexf,psint) | |
| 74 | else | |
| 75 | xtn=(xt-xln(ngrid))*xresoln(ngrid) | |
| 76 | ytn=(yt-yln(ngrid))*yresoln(ngrid) | |
| 77 | call levlininterpoln(psn,maxnests,nxmaxn,nymaxn,1,ngrid, | |
| 78 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 79 | + itime,indexf,psint) | |
| 80 | endif | |
| 81 | ||
| 82 | pt=pp(psint,zt) | |
| 83 | ||
| 84 | call zztrafo(ngrid,xtn,ytn,zt,memtime(indexf),memtime(indexf+1), | |
| 85 | +itime,indexf,psint,ht) | |
| 86 | ||
| 87 | return | |
| 88 | end |
| 0 | subroutine getmet(itime,xt,yt,zt,qqint,pvint,thint) | |
| 1 | C i i i i i i i | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * Interpolation of meteorological data (i.e. specific humidity, potential * | |
| 5 | * vorticity and potential temperature) onto trajectory positions. * | |
| 6 | * * | |
| 7 | * Author: A. Stohl * | |
| 8 | * * | |
| 9 | * 29 January 2000 * | |
| 10 | * * | |
| 11 | ******************************************************************************** | |
| 12 | * * | |
| 13 | * Variables: * | |
| 14 | * itime [s] current temporal position * | |
| 15 | * xt,yt,zt coordinates of position for which data shall be interpolat* | |
| 16 | * pvint interpolated potential vorticity * | |
| 17 | * qqint interpolated specific humidity * | |
| 18 | * thint interpolated potential temperature * | |
| 19 | * * | |
| 20 | ******************************************************************************** | |
| 21 | ||
| 22 | include 'includepar' | |
| 23 | include 'includecom' | |
| 24 | ||
| 25 | integer itime,indexf,ngrid,j | |
| 26 | real xt,yt,zt,xtn,ytn,qqint,pvint,thint | |
| 27 | ||
| 28 | ||
| 29 | C Determine the times of the wind fields needed for interpolation | |
| 30 | ****************************************************************** | |
| 31 | ||
| 32 | if ((ldirect*memtime(1).lt.ldirect*itime).and. | |
| 33 | +(ldirect*memtime(2).ge.ldirect*itime)) then ! between 1st and 2nd | |
| 34 | indexf=1 | |
| 35 | else if((ldirect*memtime(2).lt.ldirect*itime).and. | |
| 36 | +(ldirect*memtime(3).ge.ldirect*itime)) then ! between 2nd and 3rd | |
| 37 | indexf=2 | |
| 38 | endif | |
| 39 | ||
| 40 | ||
| 41 | C Determine which nesting level to be used | |
| 42 | ****************************************** | |
| 43 | ||
| 44 | ngrid=0 | |
| 45 | do 12 j=numbnests,1,-1 | |
| 46 | if ((xt.gt.xln(j)).and.(xt.lt.xrn(j)).and. | |
| 47 | + (yt.gt.yln(j)).and.(yt.lt.yrn(j))) then | |
| 48 | ngrid=j | |
| 49 | goto 13 | |
| 50 | endif | |
| 51 | 12 continue | |
| 52 | 13 continue | |
| 53 | ||
| 54 | ||
| 55 | C Do linear interpolation of the meteo data | |
| 56 | ******************************************* | |
| 57 | ||
| 58 | if (ngrid.eq.0) then ! mother grid | |
| 59 | call lininterpol(qq,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 60 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 61 | + indexf,qqint) | |
| 62 | call lininterpol(pv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 63 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 64 | + indexf,pvint) | |
| 65 | call lininterpol(th,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 66 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 67 | + indexf,thint) | |
| 68 | ||
| 69 | else if (ngrid.gt.0) then ! nested grid | |
| 70 | ||
| 71 | C Determine nested grid coordinates | |
| 72 | *********************************** | |
| 73 | ||
| 74 | xtn=(xt-xln(ngrid))*xresoln(ngrid) | |
| 75 | ytn=(yt-yln(ngrid))*yresoln(ngrid) | |
| 76 | ||
| 77 | call lininterpoln(qqn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 78 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 79 | + memtime(indexf+1),itime,indexf,qqint) | |
| 80 | call lininterpoln(pvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 81 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 82 | + memtime(indexf+1),itime,indexf,pvint) | |
| 83 | call lininterpoln(thn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 84 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 85 | + memtime(indexf+1),itime,indexf,thint) | |
| 86 | ||
| 87 | endif | |
| 88 | ||
| 89 | return | |
| 90 | end |
| 0 | subroutine getwind(firststep,init,itime,levconst,xt,yt,zt, | |
| 1 | +lkind,lkindz,iter,ngrid,uint,vint,dzdt,idiff,indwz,nstop) | |
| 2 | C i i i i i i i | |
| 3 | C i i i i o o o o o o | |
| 4 | ******************************************************************************** | |
| 5 | * * | |
| 6 | * This subroutine reads the wind fields and interpolates the wind fields to * | |
| 7 | * the current trajectory position. * | |
| 8 | * One has to distinguish between different types of trajectories, eg. isobaric* | |
| 9 | * on model layers or 3-dim. Interpolation is done separately for each of these* | |
| 10 | * types. * | |
| 11 | * * | |
| 12 | * Author: A. Stohl * | |
| 13 | * * | |
| 14 | * 26 April 1994 * | |
| 15 | * * | |
| 16 | * Update: 23 December 1998 (Use of global domain and nesting) * | |
| 17 | * * | |
| 18 | ******************************************************************************** | |
| 19 | * * | |
| 20 | * Variables: * | |
| 21 | * uint,vint,dzdt wind components in grid units per second * | |
| 22 | * firststep .true. for first iteration of petterssen * | |
| 23 | * idiff [s] Temporal distance between the windfields used for interpol* | |
| 24 | * indwz index of the model layer beneath current position of traj.* | |
| 25 | * init .true. for first time step of trajectory * | |
| 26 | * iter number of iteration step * | |
| 27 | * itime [s] current temporal position * | |
| 28 | * levconst height of trajectory in Pa, m or K, depending on type of t* | |
| 29 | * lkind kind of trajectory (e.g. isobaric, 3-dimensional) * | |
| 30 | * lkindz unit of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 31 | * memtime(3) [s] times of the wind fields in memory * | |
| 32 | * ngrid points towards which grid shall be used * | |
| 33 | * nstop =greater 0, if trajectory calculation is finished * | |
| 34 | * xt,yt,zt coordinates position for which wind data shall be calculat* | |
| 35 | * * | |
| 36 | * Constants: * | |
| 37 | * * | |
| 38 | ******************************************************************************** | |
| 39 | ||
| 40 | include 'includepar' | |
| 41 | include 'includecom' | |
| 42 | ||
| 43 | integer itime,idiff,indexf,indwz,nstop,lkind,lkindz,iter,ngrid | |
| 44 | real xt,yt,zt,levconst,uint,vint,dzdt | |
| 45 | logical firststep,init | |
| 46 | ||
| 47 | ||
| 48 | C Update of the wind fields that are currently kept in memory. | |
| 49 | C If a new wind field is necessary, read it. | |
| 50 | ************************************************************** | |
| 51 | ||
| 52 | call getfields(firststep,itime,indexf,idiff,nstop) | |
| 53 | ||
| 54 | if (nstop.ge.3) return ! error has occurred | |
| 55 | ||
| 56 | C Call interpolation of the different types of trajectories. | |
| 57 | ************************************************************ | |
| 58 | ||
| 59 | if (lkind.eq.1) then ! full 3-dimensional trajectories | |
| 60 | call inter3d(xt,yt,zt,indexf,itime,init,firststep, | |
| 61 | + iter,lkindz,ngrid,uint,vint,dzdt,indwz) | |
| 62 | else if (lkind.eq.2) then ! trajectories on model layers | |
| 63 | call intermod(xt,yt,zt,indexf,itime,init,firststep, | |
| 64 | + iter,lkindz,ngrid,uint,vint) | |
| 65 | dzdt=0. | |
| 66 | else if (lkind.eq.3) then ! mixing layer trajectories | |
| 67 | call intermix(xt,yt,zt,levconst,indexf,itime,iter,ngrid, | |
| 68 | + uint,vint) | |
| 69 | dzdt=0. | |
| 70 | else if (lkind.eq.4) then ! isobaric trajectories | |
| 71 | call interisobar(xt,yt,zt,levconst,indexf,itime,init,firststep, | |
| 72 | + iter,lkindz,ngrid,uint,vint) | |
| 73 | dzdt=0. | |
| 74 | else if (lkind.eq.5) then ! isentropic trajectories | |
| 75 | call interisentrop(xt,yt,zt,levconst,indexf,itime,init, | |
| 76 | + firststep,iter,lkindz,ngrid,uint,vint) | |
| 77 | endif | |
| 78 | ||
| 79 | return | |
| 80 | end |
| 0 | subroutine gridcheck(oronew,error) | |
| 1 | ************************************************************************ | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE GRIDCHECK * | |
| 4 | * * | |
| 5 | ************************************************************************ | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1997-08-06 * | |
| 9 | * * | |
| 10 | * Update: 1998-12, global fields allowed, A. Stohl * | |
| 11 | * 2011-06, implemented reading of grib2 format* | |
| 12 | * analog to FLEXPART 8.22 routines * | |
| 13 | * * | |
| 14 | ************************************************************************ | |
| 15 | * * | |
| 16 | * DESCRIPTION: * | |
| 17 | * * | |
| 18 | * THIS SUBROUTINE DETERMINES THE GRID SPECIFICATIONS (LOWER LEFT * | |
| 19 | * LONGITUDE, LOWER LEFT LATITUDE, NUMBER OF GRID POINTS, GRID DIST- * | |
| 20 | * ANCE AND VERTICAL DISCRETIZATION OF THE ECMWF MODEL) FROM THE * | |
| 21 | * GRIB HEADER OF THE FIRST INPUT FILE. THE CONSISTANCY (NO CHANGES * | |
| 22 | * WITHIN ONE FLEXTRA RUN) IS CHECKED IN THE ROUTINE "READWIND" AT ANY * | |
| 23 | * CALL. * | |
| 24 | * * | |
| 25 | * OUTPUT error .true. - can not read grid specifications * | |
| 26 | * error .false. - normal * | |
| 27 | * oronew .true. - Terrain heights given in grib files * | |
| 28 | * oronew .false. - Terrain heights not specified in the * | |
| 29 | * grib files (old file standard) * | |
| 30 | * * | |
| 31 | * XLON0 geographical longitude of lower left gridpoint * | |
| 32 | * XLAT0 geographical latitude of lower left gridpoint * | |
| 33 | * NX number of grid points x-direction * | |
| 34 | * NY number of grid points y-direction * | |
| 35 | * DX grid distance x-direction * | |
| 36 | * DY grid distance y-direction * | |
| 37 | * NUVZ number of grid points for horizontal wind * | |
| 38 | * components in z direction * | |
| 39 | * NWZ number of grid points for vertical wind * | |
| 40 | * sizesouth, sizenorth give the map scale (i.e. number of virtual grid* | |
| 41 | * points of the polar stereographic grid): * | |
| 42 | * used to check the CFL criterion * | |
| 43 | * component in z direction * | |
| 44 | * UVHEIGHT(1)- heights of gridpoints where u and v are * | |
| 45 | * UVHEIGHT(NUVZ) given * | |
| 46 | * WHEIGHT(1)- heights of gridpoints where w is given * | |
| 47 | * WHEIGHT(NWZ) * | |
| 48 | * * | |
| 49 | *********************************************************************** | |
| 50 | * | |
| 51 | use grib_api | |
| 52 | ||
| 53 | include 'includepar' | |
| 54 | include 'includecom' | |
| 55 | ||
| 56 | integer i,ifn,ifield,j,k,iumax,iwmax,numskip | |
| 57 | real sizesouth,sizenorth,xauxa | |
| 58 | logical error,oronew | |
| 59 | ||
| 60 | !HSO parameters for grib_api | |
| 61 | integer ifile | |
| 62 | integer iret | |
| 63 | integer igrib | |
| 64 | integer gotGrid | |
| 65 | real*4 xaux1,xaux2,yaux1,yaux2 | |
| 66 | real*8 xaux1in,xaux2in,yaux1in,yaux2in | |
| 67 | integer gribVer,parCat,parNum,typSurf,valSurf,discipl | |
| 68 | character*24 gribErrorMsg | |
| 69 | character*20 gribFunction | |
| 70 | !HSO end | |
| 71 | ||
| 72 | * VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING | |
| 73 | ||
| 74 | C dimension of isec2 at least (22+n), where n is the number of parallels or | |
| 75 | C meridians in a quasi-regular (reduced) Gaussian or lat/long grid | |
| 76 | ||
| 77 | C dimension of zsec2 at least (10+nn), where nn is the number of vertical | |
| 78 | C coordinate parameters | |
| 79 | ||
| 80 | integer isec0(2),isec1(56),isec2(22+nxmax+nymax),isec3(2) | |
| 81 | integer isec4(64),inbuff(jpack),ilen,iswap,ierr,iword,lunit | |
| 82 | real zsec2(91+2*nuvzmax),zsec3(2),zsec4(jpunp) | |
| 83 | character*1 yoper,opt | |
| 84 | data yoper/'D'/ | |
| 85 | ||
| 86 | error=.false. | |
| 87 | oronew=.false. | |
| 88 | iumax=0 | |
| 89 | iwmax=0 | |
| 90 | * | |
| 91 | if(ideltas.gt.0) then | |
| 92 | ifn=1 | |
| 93 | else | |
| 94 | ifn=numbwf | |
| 95 | endif | |
| 96 | * | |
| 97 | * OPENING OF DATA FILE (GRIB CODE) | |
| 98 | * | |
| 99 | 5 call grib_open_file(ifile,path(3)(1:len(3)) | |
| 100 | >//trim(wfname(ifn)),'r',iret) | |
| 101 | if (iret.ne.GRIB_SUCCESS) then | |
| 102 | goto 999 ! ERROR DETECTED | |
| 103 | endif | |
| 104 | ! turn on support for multi fields messages | |
| 105 | ! call grib_multi_support_on() | |
| 106 | ||
| 107 | gotGrid=0 | |
| 108 | ifield=0 | |
| 109 | 10 ifield=ifield+1 | |
| 110 | ||
| 111 | * | |
| 112 | * GET NEXT FIELDS | |
| 113 | * | |
| 114 | call grib_new_from_file(ifile,igrib,iret) | |
| 115 | if (iret.eq.GRIB_END_OF_FILE ) then | |
| 116 | goto 30 ! EOF DETECTED | |
| 117 | elseif (iret.ne.GRIB_SUCCESS) then | |
| 118 | goto 999 ! ERROR DETECTED | |
| 119 | endif | |
| 120 | ||
| 121 | ! first see if we read GRIB1 or GRIB2 | |
| 122 | call grib_get_int(igrib,'editionNumber',gribVer,iret) | |
| 123 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 124 | ||
| 125 | C GRIB 1 | |
| 126 | C ******************************************************************* | |
| 127 | if (gribVer.eq.1) then | |
| 128 | C print*,'GRiB Edition 1' | |
| 129 | c read the grib2 identifiers | |
| 130 | call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret) | |
| 131 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 132 | call grib_get_int(igrib,'level',isec1(8),iret) | |
| 133 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 134 | ||
| 135 | c change code for etadot to code for omega | |
| 136 | if (isec1(6).eq.77) then | |
| 137 | isec1(6)=135 | |
| 138 | endif | |
| 139 | C GRIB 2 | |
| 140 | C ******************************************************************* | |
| 141 | else | |
| 142 | C print*,'GRiB Edition 2' | |
| 143 | c read the grib2 identifiers | |
| 144 | call grib_get_int(igrib,'discipline',discipl,iret) | |
| 145 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 146 | call grib_get_int(igrib,'parameterCategory',parCat,iret) | |
| 147 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 148 | call grib_get_int(igrib,'parameterNumber',parNum,iret) | |
| 149 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 150 | call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret) | |
| 151 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 152 | call grib_get_int(igrib,'level',valSurf,iret) | |
| 153 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 154 | ||
| 155 | ! convert to grib1 identifiers | |
| 156 | isec1(6)=-1 | |
| 157 | isec1(7)=-1 | |
| 158 | isec1(8)=-1 | |
| 159 | isec1(8)=valSurf ! level | |
| 160 | ||
| 161 | if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105))then ! T | |
| 162 | isec1(6)=130 ! indicatorOfParameter | |
| 163 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105))then ! U | |
| 164 | isec1(6)=131 ! indicatorOfParameter | |
| 165 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105))then ! V | |
| 166 | isec1(6)=132 ! indicatorOfParameter | |
| 167 | elseif((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105))then ! Q | |
| 168 | isec1(6)=133 ! indicatorOfParameter | |
| 169 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1))then !SP | |
| 170 | isec1(6)=134 ! indicatorOfParameter | |
| 171 | elseif((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot | |
| 172 | isec1(6)=135 ! indicatorOfParameter | |
| 173 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101))then !SLP | |
| 174 | isec1(6)=151 ! indicatorOfParameter | |
| 175 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103))then ! 10U | |
| 176 | isec1(6)=165 ! indicatorOfParameter | |
| 177 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103))then ! 10V | |
| 178 | isec1(6)=166 ! indicatorOfParameter | |
| 179 | elseif((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103))then ! 2T | |
| 180 | isec1(6)=167 ! indicatorOfParameter | |
| 181 | elseif((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103))then ! 2D | |
| 182 | isec1(6)=168 ! indicatorOfParameter | |
| 183 | elseif((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1))then ! SD | |
| 184 | isec1(6)=141 ! indicatorOfParameter | |
| 185 | elseif((parCat.eq.6).and.(parNum.eq.1)) then ! CC | |
| 186 | isec1(6)=164 ! indicatorOfParameter | |
| 187 | elseif((parCat.eq.1).and.(parNum.eq.9)) then ! LSP | |
| 188 | isec1(6)=142 ! indicatorOfParameter | |
| 189 | elseif((parCat.eq.1).and.(parNum.eq.10)) then ! CP | |
| 190 | isec1(6)=143 ! indicatorOfParameter | |
| 191 | elseif((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1))then ! SHF | |
| 192 | isec1(6)=146 ! indicatorOfParameter | |
| 193 | elseif((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1))then ! SR | |
| 194 | isec1(6)=176 ! indicatorOfParameter | |
| 195 | elseif((parCat.eq.2).and.(parNum.eq.17))then ! EWSS | |
| 196 | isec1(6)=180 ! indicatorOfParameter | |
| 197 | elseif((parCat.eq.2).and.(parNum.eq.18))then ! NSSS | |
| 198 | isec1(6)=181 ! indicatorOfParameter | |
| 199 | elseif((parCat.eq.3).and.(parNum.eq.4))then ! ORO | |
| 200 | isec1(6)=129 ! indicatorOfParameter | |
| 201 | elseif((parCat.eq.3).and.(parNum.eq.7))then ! SDO | |
| 202 | isec1(6)=160 ! indicatorOfParameter | |
| 203 | elseif((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. | |
| 204 | + (typSurf.eq.1)) then ! LSM | |
| 205 | isec1(6)=172 ! indicatorOfParameter | |
| 206 | else | |
| 207 | print*,'***ERROR: undefined GRiB2 message found!',discipl, | |
| 208 | + parCat,parNum,typSurf | |
| 209 | endif | |
| 210 | ||
| 211 | ||
| 212 | endif | |
| 213 | ||
| 214 | ! get the size and data of the values array | |
| 215 | if (isec1(6).ne.-1) then | |
| 216 | call grib_get_real4_array(igrib,'values',zsec4,iret) | |
| 217 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 218 | endif | |
| 219 | ||
| 220 | if(ifield.eq.1) then | |
| 221 | !HSO get the required fields from section 2 in a gribex compatible manner | |
| 222 | call grib_get_int(igrib,'numberOfPointsAlongAParallel', | |
| 223 | > isec2(2),iret) | |
| 224 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 225 | call grib_get_int(igrib,'numberOfPointsAlongAMeridian', | |
| 226 | > isec2(3),iret) | |
| 227 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 228 | call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', | |
| 229 | > xaux1in,iret) | |
| 230 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 231 | call grib_get_int(igrib,'numberOfVerticalCoordinateValues', | |
| 232 | > isec2(12),iret) | |
| 233 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 234 | ||
| 235 | ! get the size and data of the vertical coordinate array | |
| 236 | call grib_get_real4_array(igrib,'pv',zsec2,iret) | |
| 237 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 238 | ||
| 239 | nxfield=isec2(2) | |
| 240 | ny=isec2(3) | |
| 241 | nlev_ec=isec2(12)/2-1 | |
| 242 | endif | |
| 243 | ||
| 244 | !HSO get the second part of the grid dimensions only from GRiB1 messages | |
| 245 | if ((gribVer.eq.1).and.(gotGrid.eq.0)) then | |
| 246 | call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', | |
| 247 | > xaux2in,iret) | |
| 248 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 249 | call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', | |
| 250 | > yaux1in,iret) | |
| 251 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 252 | call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', | |
| 253 | > yaux2in,iret) | |
| 254 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 255 | xaux1=xaux1in | |
| 256 | xaux2=xaux2in | |
| 257 | yaux1=yaux1in | |
| 258 | yaux2=yaux2in | |
| 259 | if (xaux1.gt.180.) xaux1=xaux1-360.0 | |
| 260 | if (xaux2.gt.180.) xaux2=xaux2-360.0 | |
| 261 | if (xaux1.lt.-180.) xaux1=xaux1+360.0 | |
| 262 | if (xaux2.lt.-180.) xaux2=xaux2+360.0 | |
| 263 | if (xaux2.lt.xaux1) xaux2=xaux2+360.0 | |
| 264 | xlon0=xaux1 | |
| 265 | ylat0=yaux1 | |
| 266 | dx=(xaux2-xaux1)/float(nxfield-1) | |
| 267 | dy=(yaux2-yaux1)/float(ny-1) | |
| 268 | gotGrid=1 | |
| 269 | ||
| 270 | C Check whether fields are global | |
| 271 | C If they contain the poles, specify polar stereographic map | |
| 272 | C projections using the stlmbr- and stcm2p-calls | |
| 273 | ************************************************************ | |
| 274 | ||
| 275 | if (xauxa.lt.0.001) then | |
| 276 | nx=nxfield+1 ! field is cyclic | |
| 277 | xglobal=.true. | |
| 278 | else | |
| 279 | nx=nxfield | |
| 280 | xglobal=.false. | |
| 281 | endif | |
| 282 | if (xlon0.gt.180.) xlon0=xlon0-360. | |
| 283 | xauxa=abs(yaux1+90.) | |
| 284 | if (xglobal.and.xauxa.lt.0.001) then | |
| 285 | sglobal=.true. ! field contains south pole | |
| 286 | C Enhance the map scale by factor 3 (*2=6) compared to north-south | |
| 287 | C map scale | |
| 288 | sizesouth=6.*(switchsouth+90.)/dy | |
| 289 | call stlmbr(southpolemap,-90.,0.) | |
| 290 | call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, | |
| 291 | + sizesouth,switchsouth,180.) | |
| 292 | switchsouthg=(switchsouth-ylat0)/dy | |
| 293 | else | |
| 294 | sglobal=.false. | |
| 295 | switchsouthg=999999. | |
| 296 | endif | |
| 297 | xauxa=abs(yaux2-90.) | |
| 298 | if (xglobal.and.xauxa.lt.0.001) then | |
| 299 | nglobal=.true. ! field contains north pole | |
| 300 | C Enhance the map scale by factor 3 (*2=6) compared to north-south | |
| 301 | C map scale | |
| 302 | sizenorth=6.*(90.-switchnorth)/dy | |
| 303 | call stlmbr(northpolemap,90.,0.) | |
| 304 | call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, | |
| 305 | + sizenorth,switchnorth,180.) | |
| 306 | switchnorthg=(switchnorth-ylat0)/dy | |
| 307 | else | |
| 308 | nglobal=.false. | |
| 309 | switchnorthg=999999. | |
| 310 | endif | |
| 311 | endif ! gotGrid | |
| 312 | ||
| 313 | k=isec1(8) | |
| 314 | if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1) | |
| 315 | if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1) | |
| 316 | ||
| 317 | if(isec1(6).eq.129) then | |
| 318 | oronew=.true. | |
| 319 | do 20 j=0,ny-1 | |
| 320 | do 21 i=0,nxfield-1 | |
| 321 | 21 oro(i,j)=zsec4(nxfield*(ny-j-1)+i+1)/ga | |
| 322 | if (xglobal) oro(nx-1,j)=oro(0,j) | |
| 323 | 20 continue | |
| 324 | endif | |
| 325 | ||
| 326 | call grib_release(igrib) | |
| 327 | goto 10 !! READ NEXT LEVEL OR PARAMETER | |
| 328 | * | |
| 329 | * CLOSING OF INPUT DATA FILE | |
| 330 | * | |
| 331 | 30 call grib_close_file(ifile) | |
| 332 | ||
| 333 | * error message if no fields found with correct first longitude in it | |
| 334 | if (gotGrid.eq.0) then | |
| 335 | print*,'***ERROR: input file needs to contain GRiB1 formatted'// | |
| 336 | &'messages' | |
| 337 | stop | |
| 338 | endif | |
| 339 | ||
| 340 | nuvz=iumax | |
| 341 | nwz =iwmax | |
| 342 | if(nuvz.eq.nlev_ec) nwz=nlev_ec+1 | |
| 343 | ||
| 344 | if (nx.gt.nxmax) then | |
| 345 | write(*,*) 'FLEXTRA error: Too many grid points in x direction.' | |
| 346 | write(*,*) 'Reduce resolution of wind fields.' | |
| 347 | write(*,*) 'Or change parameter settings in file includepar.' | |
| 348 | write(*,*) nx,nxmax | |
| 349 | error=.true. | |
| 350 | return | |
| 351 | endif | |
| 352 | ||
| 353 | if (ny.gt.nymax) then | |
| 354 | write(*,*) 'FLEXTRA error: Too many grid points in y direction.' | |
| 355 | write(*,*) 'Reduce resolution of wind fields.' | |
| 356 | write(*,*) 'Or change parameter settings in file includepar.' | |
| 357 | write(*,*) ny,nymax | |
| 358 | error=.true. | |
| 359 | return | |
| 360 | endif | |
| 361 | ||
| 362 | if (nuvz.gt.nuvzmax) then | |
| 363 | write(*,*) 'FLEXTRA error: Too many u,v grid points in z '// | |
| 364 | +'direction.' | |
| 365 | write(*,*) 'Reduce resolution of wind fields.' | |
| 366 | write(*,*) 'Or change parameter settings in file includepar.' | |
| 367 | write(*,*) nuvz+1,nuvzmax | |
| 368 | error=.true. | |
| 369 | return | |
| 370 | endif | |
| 371 | ||
| 372 | if (nwz.gt.nwzmax) then | |
| 373 | write(*,*) 'FLEXTRA error: Too many w grid points in z '// | |
| 374 | +'direction.' | |
| 375 | write(*,*) 'Reduce resolution of wind fields.' | |
| 376 | write(*,*) 'Or change parameter settings in file includepar.' | |
| 377 | write(*,*) nwz,nwzmax | |
| 378 | error=.true. | |
| 379 | return | |
| 380 | endif | |
| 381 | ||
| 382 | C Output of grid info | |
| 383 | ********************* | |
| 384 | ||
| 385 | write(*,*) | |
| 386 | write(*,*) | |
| 387 | write(*,'(a,2i7)') '# of vertical levels: ',nuvz,nwz | |
| 388 | write(*,*) | |
| 389 | write(*,'(a)') 'Mother domain:' | |
| 390 | write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Longitude range: ', | |
| 391 | +xlon0,' to ',xlon0+(nx-1)*dx,' Grid distance: ',dx | |
| 392 | write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Latitude range: ', | |
| 393 | +ylat0,' to ',ylat0+(ny-1)*dy,' Grid distance: ',dy | |
| 394 | write(*,*) | |
| 395 | ||
| 396 | ||
| 397 | C Compute often used aux variables to convert geografical into grid coord. | |
| 398 | *************************************************************************** | |
| 399 | ||
| 400 | xthelp=180./pi/r_earth/dx | |
| 401 | ythelp=180./pi/r_earth/dy | |
| 402 | ||
| 403 | ||
| 404 | * CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL | |
| 405 | * PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM | |
| 406 | * wheight(i) IS THE HEIGHT OF THE i-th MODEL HALF LEVEL (=INTERFACE BETWEEN | |
| 407 | * 2 MODEL LEVELS) IN THE "ETA" SYSTEM | |
| 408 | ||
| 409 | numskip=nlev_ec-nuvz ! number of ecmwf model layers not used | |
| 410 | ! by trajectory model | |
| 411 | do 40 i=1,nwz | |
| 412 | j=numskip+i | |
| 413 | k=nlev_ec+1+numskip+i | |
| 414 | akm(nwz-i+1)=zsec2(j) | |
| 415 | bkm(nwz-i+1)=zsec2(k) | |
| 416 | 40 wheight(nwz-i+1)=akm(nwz-i+1)/p0+bkm(nwz-i+1) | |
| 417 | ||
| 418 | * CALCULATION OF uvheight, akz, bkz | |
| 419 | * akz,bkz ARE THE DISCRETIZATION PARAMETERS FOR THE MODEL LEVELS | |
| 420 | * uvheight(i) IS THE HEIGHT OF THE i-th MODEL LEVEL IN THE "ETA" SYSTEM | |
| 421 | ||
| 422 | do 45 i=1,nuvz | |
| 423 | uvheight(i)=0.5*(wheight(i+1)+wheight(i)) | |
| 424 | akz(i)=0.5*(akm(i+1)+akm(i)) | |
| 425 | bkz(i)=0.5*(bkm(i+1)+bkm(i)) | |
| 426 | 45 continue | |
| 427 | ||
| 428 | C If vertical coordinates decrease with increasing altitude, multiply by -1. | |
| 429 | C This means that also the vertical velocities have to be multiplied by -1. | |
| 430 | **************************************************************************** | |
| 431 | ||
| 432 | if (uvheight(1).lt.uvheight(nuvz)) then | |
| 433 | zdirect=1. | |
| 434 | else | |
| 435 | zdirect=-1. | |
| 436 | do 55 i=1,nuvz | |
| 437 | 55 uvheight(i)=zdirect*uvheight(i) | |
| 438 | do 65 i=1,nwz | |
| 439 | 65 wheight(i)=zdirect*wheight(i) | |
| 440 | endif | |
| 441 | ||
| 442 | ||
| 443 | C Compute minimum and maximum height of modelling domain | |
| 444 | ******************************************************** | |
| 445 | ||
| 446 | heightmin=max(uvheight(1),wheight(1)) | |
| 447 | heightmax=min(uvheight(nuvz),wheight(nwz)) | |
| 448 | ||
| 449 | ||
| 450 | return | |
| 451 | ||
| 452 | 999 write(*,*) | |
| 453 | write(*,*) ' ###########################################'// | |
| 454 | & '###### ' | |
| 455 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE GRIDCHECK:' | |
| 456 | write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn) | |
| 457 | write(*,*) ' ###########################################'// | |
| 458 | & '###### ' | |
| 459 | write(*,*) | |
| 460 | write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND !!!' | |
| 461 | write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE... !!!' | |
| 462 | write(*,'(a)') '!!! ...OR TERMINATE FLEXTRA PRESSING !!!' | |
| 463 | write(*,'(a)') '!!! THE "X" KEY... !!!' | |
| 464 | write(*,*) | |
| 465 | read(*,'(a)') opt | |
| 466 | if(opt.eq.'X') then | |
| 467 | error=.true. | |
| 468 | else | |
| 469 | goto 5 | |
| 470 | endif | |
| 471 | ||
| 472 | return | |
| 473 | end |
| 0 | subroutine gridcheck(oronew,error) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE GRIDCHECK * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1997-08-06 * | |
| 9 | * * | |
| 10 | * Update: 1998-12, global fields allowed, A. Stohl * | |
| 11 | * Modification:2001-01, NCEP Pressure level data, * | |
| 12 | * G. Wotawa * | |
| 13 | * Sabine Eckhardt, Jan 2008 update to read GRIB2 with * | |
| 14 | * Grib Api * | |
| 15 | * * | |
| 16 | *********************************************************************** | |
| 17 | * * | |
| 18 | * DESCRIPTION: * | |
| 19 | * * | |
| 20 | * THIS SUBROUTINE DETERMINES THE GRID SPECIFICATIONS (LOWER LEFT * | |
| 21 | * LONGITUDE, LOWER LEFT LATITUDE, NUMBER OF GRID POINTS, GRID DIST- * | |
| 22 | * ANCE AND VERTICAL DISCRETIZATION OF THE ECMWF MODEL) FROM THE * | |
| 23 | * GRIB HEADER OF THE FIRST INPUT FILE. THE CONSISTANCY (NO CHANGES * | |
| 24 | * WITHIN ONE FLEXTRA RUN) IS CHECKED IN THE ROUTINE "READWIND" AT ANY * | |
| 25 | * CALL. * | |
| 26 | * * | |
| 27 | * OUTPUT error .true. - can not read grid specifications * | |
| 28 | * error .false. - normal * | |
| 29 | * oronew .true. - Terrain heights given in grib files * | |
| 30 | * oronew .false. - Terrain heights not specified in the * | |
| 31 | * grib files (old file standard) * | |
| 32 | * * | |
| 33 | * XLON0 geographical longitude of lower left gridpoint * | |
| 34 | * XLAT0 geographical latitude of lower left gridpoint * | |
| 35 | * NX number of grid points x-direction * | |
| 36 | * NY number of grid points y-direction * | |
| 37 | * DX grid distance x-direction * | |
| 38 | * DY grid distance y-direction * | |
| 39 | * NUVZ number of grid points for horizontal wind * | |
| 40 | * components in z direction * | |
| 41 | * NWZ number of grid points for vertical wind * | |
| 42 | * sizesouth, sizenorth give the map scale (i.e. number of virtual grid* | |
| 43 | * points of the polar stereographic grid): * | |
| 44 | * used to check the CFL criterion * | |
| 45 | * component in z direction * | |
| 46 | * UVHEIGHT(1)- heights of gridpoints where u and v are * | |
| 47 | * UVHEIGHT(NUVZ) given * | |
| 48 | * WHEIGHT(1)- heights of gridpoints where w is given * | |
| 49 | * WHEIGHT(NWZ) * | |
| 50 | * * | |
| 51 | *********************************************************************** | |
| 52 | * | |
| 53 | include 'includepar' | |
| 54 | include 'includecom' | |
| 55 | include 'grib_api_f77.h' | |
| 56 | ||
| 57 | ||
| 58 | ||
| 59 | integer i,ifn,ifield,j,k,iumax,iwmax,numskip | |
| 60 | real sizesouth,sizenorth,xauxa | |
| 61 | real plev(nwzmax),help | |
| 62 | logical error,oronew | |
| 63 | ||
| 64 | * VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING | |
| 65 | ||
| 66 | C dimension of isec2 at least (22+n), where n is the number of parallels or | |
| 67 | C meridians in a quasi-regular (reduced) Gaussian or lat/long grid | |
| 68 | ||
| 69 | C dimension of zsec2 at least (10+nn), where nn is the number of vertical | |
| 70 | C coordinate parameters | |
| 71 | ||
| 72 | integer isec1(56),isec2(22+nxmax+nymax) | |
| 73 | real zsec4(jpunp) | |
| 74 | ||
| 75 | !HSO parameters for grib_api | |
| 76 | integer ifile | |
| 77 | integer iret | |
| 78 | integer igrib | |
| 79 | integer*4 isize | |
| 80 | real*4 xaux1,xaux2,yaux1,yaux2 | |
| 81 | real*8 xaux1in,xaux2in,yaux1in,yaux2in,zsecn4(jpunp*4) | |
| 82 | integer gribVer,parCat,parNum,typSurf,valSurf | |
| 83 | !HSO end | |
| 84 | ||
| 85 | integer i179,i180,i181 | |
| 86 | real akm_usort(nwzmax) | |
| 87 | ||
| 88 | error=.false. | |
| 89 | oronew=.false. | |
| 90 | iumax=0 | |
| 91 | iwmax=0 | |
| 92 | * | |
| 93 | if(ideltas.gt.0) then | |
| 94 | ifn=1 | |
| 95 | else | |
| 96 | ifn=numbwf | |
| 97 | endif | |
| 98 | ||
| 99 | * | |
| 100 | * OPENING OF DATA FILE (GRIB CODE) | |
| 101 | * | |
| 102 | ifile=5 | |
| 103 | 5 iret=grib_open_file(ifile,path(3)(1:len(3))// | |
| 104 | >trim(wfname(ifn)),'r') | |
| 105 | call grib_check(iret) | |
| 106 | ! turn on support for multi fields messages */ | |
| 107 | call grib_check(grib_multi_support_on()) | |
| 108 | !HSO 5 call pbopen(lunit,path(3)(1:len(3))//wfname(ifn),'r',ierr) | |
| 109 | ! if(ierr.lt.0) goto 999 | |
| 110 | !HSO fin | |
| 111 | ||
| 112 | ifield=0 | |
| 113 | 10 ifield=ifield+1 | |
| 114 | ||
| 115 | * | |
| 116 | * GET NEXT FIELDS | |
| 117 | * | |
| 118 | iret = grib_new_from_file(ifile,igrib) | |
| 119 | if (igrib .eq. -1 ) then | |
| 120 | if (iret .ne. -1) then | |
| 121 | call grib_check(iret) | |
| 122 | goto 999 ! ERROR DETECTED | |
| 123 | endif | |
| 124 | goto 30 ! EOF DETECTED | |
| 125 | endif | |
| 126 | ||
| 127 | ||
| 128 | ||
| 129 | C Check whether we are on a little endian or on a big endian computer | |
| 130 | ********************************************************************* | |
| 131 | ||
| 132 | c if (inbuff(1).eq.1112101447) then ! little endian, swap bytes | |
| 133 | c iswap=1+ilen/4 | |
| 134 | c call swap32(inbuff,iswap) | |
| 135 | c else if (inbuff(1).ne.1196575042) then ! big endian | |
| 136 | c stop 'subroutine gridcheck: corrupt GRIB data' | |
| 137 | c endif | |
| 138 | ||
| 139 | ||
| 140 | ||
| 141 | ! first see if we read GRIB1 or GRIB2 | |
| 142 | call grib_check(grib_get_int( igrib, | |
| 143 | >'editionNumber',gribVer)) | |
| 144 | ||
| 145 | ! get the size and data of the values array | |
| 146 | call grib_check(grib_get_size(igrib,'values',isize)) | |
| 147 | call grib_check(grib_get_real8_array(igrib,'values',zsecn4,isize)) | |
| 148 | do i=1,isize | |
| 149 | zsec4(i)=zsecn4(i) | |
| 150 | enddo | |
| 151 | ||
| 152 | if (gribVer.eq.1) then ! GRIB Edition 1 | |
| 153 | ||
| 154 | ! read the grib1 identifiers | |
| 155 | call grib_check(grib_get_int( igrib, | |
| 156 | >'indicatorOfParameter',isec1(6))) | |
| 157 | call grib_check(grib_get_int( igrib, | |
| 158 | >'indicatorOfTypeOfLevel',isec1(7))) | |
| 159 | call grib_check(grib_get_int( igrib, | |
| 160 | >'level',isec1(8))) | |
| 161 | ||
| 162 | else ! GRIB Edition 2 | |
| 163 | ||
| 164 | ! read the grib2 identifiers | |
| 165 | call grib_check(grib_get_int( igrib, | |
| 166 | >'parameterCategory',parCat)) | |
| 167 | call grib_check(grib_get_int( igrib, | |
| 168 | >'parameterNumber',parNum)) | |
| 169 | call grib_check(grib_get_int( igrib, | |
| 170 | >'typeOfFirstFixedSurface',typSurf)) | |
| 171 | call grib_check(grib_get_int( igrib, | |
| 172 | >'scaledValueOfFirstFixedSurface',valSurf)) | |
| 173 | ||
| 174 | ! convert to grib1 identifiers | |
| 175 | isec1(6)=-1 | |
| 176 | isec1(7)=-1 | |
| 177 | isec1(8)=-1 | |
| 178 | if ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.100)) then ! U | |
| 179 | isec1(6)=33 ! indicatorOfParameter | |
| 180 | isec1(7)=100 ! indicatorOfTypeOfLevel | |
| 181 | isec1(8)=valSurf/100 ! level, convert to hPa | |
| 182 | elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSurf.eq.1)) then ! TOPO | |
| 183 | isec1(6)=7 ! indicatorOfParameter | |
| 184 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 185 | isec1(8)=0 | |
| 186 | elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.1)) then ! LSM | |
| 187 | isec1(6)=81 ! indicatorOfParameter | |
| 188 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 189 | isec1(8)=0 | |
| 190 | endif | |
| 191 | ||
| 192 | endif ! gribVer | |
| 193 | ||
| 194 | if(ifield.eq.1) then | |
| 195 | ||
| 196 | ! get the required fields from section 2 | |
| 197 | ! store compatible to gribex input | |
| 198 | call grib_check(grib_get_int( igrib, | |
| 199 | >'numberOfPointsAlongAParallel',isec2(2))) | |
| 200 | call grib_check(grib_get_int( igrib, | |
| 201 | >'numberOfPointsAlongAMeridian',isec2(3))) | |
| 202 | call grib_check(grib_get_real8(igrib, | |
| 203 | >'latitudeOfFirstGridPointInDegrees',yaux2in)) | |
| 204 | call grib_check(grib_get_real8(igrib, | |
| 205 | >'longitudeOfFirstGridPointInDegrees',xaux1in)) | |
| 206 | call grib_check(grib_get_real8(igrib, | |
| 207 | >'latitudeOfLastGridPointInDegrees',yaux1in)) | |
| 208 | call grib_check(grib_get_real8(igrib, | |
| 209 | >'longitudeOfLastGridPointInDegrees',xaux2in)) | |
| 210 | xaux1=xaux1in | |
| 211 | xaux2=xaux2in | |
| 212 | yaux1=yaux1in | |
| 213 | yaux2=yaux2in | |
| 214 | ||
| 215 | c if (ierr.ne.0) goto 10 ! ERROR DETECTED | |
| 216 | ||
| 217 | ||
| 218 | ||
| 219 | nxfield=isec2(2) | |
| 220 | ny=isec2(3) | |
| 221 | if((abs(xaux1).lt.eps).and.(xaux2.ge.359)) then ! NCEP DATA FROM 0 TO | |
| 222 | xaux1=-179.0 ! 359 DEG EAST -> | |
| 223 | xaux2=-179.0+360.-360./float(nxfield) ! TRANSFORMED TO -179 | |
| 224 | endif ! TO 180 DEG EAST | |
| 225 | if (xaux1.gt.180) xaux1=xaux1-360.0 | |
| 226 | if (xaux2.gt.180) xaux2=xaux2-360.0 | |
| 227 | if (xaux1.lt.-180) xaux1=xaux1+360.0 | |
| 228 | if (xaux2.lt.-180) xaux2=xaux2+360.0 | |
| 229 | if (xaux2.lt.xaux1) xaux2=xaux2+360. | |
| 230 | xlon0=xaux1 | |
| 231 | ylat0=yaux1 | |
| 232 | dx=(xaux2-xaux1)/float(nxfield-1) | |
| 233 | dy=(yaux2-yaux1)/float(ny-1) | |
| 234 | ||
| 235 | i179=nint(179./dx) | |
| 236 | i180=nint(179./dx)+1 | |
| 237 | i181=i180+1 | |
| 238 | ||
| 239 | C Check whether fields are global | |
| 240 | C If they contain the poles, specify polar stereographic map | |
| 241 | C projections using the stlmbr- and stcm2p-calls | |
| 242 | ************************************************************ | |
| 243 | ||
| 244 | xauxa=abs(xaux2+dx-360.-xaux1) | |
| 245 | if (xauxa.lt.0.001) then | |
| 246 | nx=nxfield+1 ! field is cyclic | |
| 247 | xglobal=.true. | |
| 248 | else | |
| 249 | nx=nxfield | |
| 250 | xglobal=.false. | |
| 251 | endif | |
| 252 | xauxa=abs(yaux1+90.) | |
| 253 | if (xglobal.and.xauxa.lt.0.001) then | |
| 254 | sglobal=.true. ! field contains south pole | |
| 255 | C Enhance the map scale by factor 3 (*2=6) compared to north-south | |
| 256 | C map scale | |
| 257 | sizesouth=6.*(switchsouth+90.)/dy | |
| 258 | call stlmbr(southpolemap,-90.,0.) | |
| 259 | call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, | |
| 260 | + sizesouth,switchsouth,180.) | |
| 261 | switchsouthg=(switchsouth-ylat0)/dy | |
| 262 | else | |
| 263 | sglobal=.false. | |
| 264 | switchsouthg=999999. | |
| 265 | endif | |
| 266 | xauxa=abs(yaux2-90.) | |
| 267 | if (xglobal.and.xauxa.lt.0.001) then | |
| 268 | nglobal=.true. ! field contains north pole | |
| 269 | C Enhance the map scale by factor 3 (*2=6) compared to north-south | |
| 270 | C map scale | |
| 271 | sizenorth=6.*(90.-switchnorth)/dy | |
| 272 | call stlmbr(northpolemap,90.,0.) | |
| 273 | call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, | |
| 274 | + sizenorth,switchnorth,180.) | |
| 275 | switchnorthg=(switchnorth-ylat0)/dy | |
| 276 | else | |
| 277 | nglobal=.false. | |
| 278 | switchnorthg=999999. | |
| 279 | endif | |
| 280 | endif | |
| 281 | ||
| 282 | ||
| 283 | if((isec1(6).eq.007).and.(isec1(7).eq.001)) oronew=.true. | |
| 284 | * k=isec1(8) | |
| 285 | * if(isec1(6).eq. 33) iumax=max(iumax,nlev_ec-k+1) | |
| 286 | * if(isec1(6).eq. 39) iwmax=max(iwmax,nlev_ec-k+1) | |
| 287 | if((isec1(6).eq.33).and.(isec1(7).eq.100)) then | |
| 288 | iumax=iumax+1 | |
| 289 | plev(iumax)=float(isec1(8))*100.0 | |
| 290 | endif | |
| 291 | ||
| 292 | if((isec1(6).eq.007).and.(isec1(7).eq.001)) then | |
| 293 | * TOPOGRAPHY | |
| 294 | do 20 j=0,ny-1 | |
| 295 | do 21 i=0,nxfield-1 | |
| 296 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 297 | if(i.le.180) then | |
| 298 | oro(i179+i,j)=help | |
| 299 | else | |
| 300 | oro(i-i181,j)=help | |
| 301 | endif | |
| 302 | 21 continue | |
| 303 | 20 continue | |
| 304 | endif | |
| 305 | ||
| 306 | if (igrib.ne.-1) then | |
| 307 | call grib_check(grib_release(igrib)) | |
| 308 | endif | |
| 309 | ||
| 310 | goto 10 !! READ NEXT LEVEL OR PARAMETER | |
| 311 | ||
| 312 | 30 continue | |
| 313 | ||
| 314 | * | |
| 315 | * CLOSING OF INPUT DATA FILE | |
| 316 | * | |
| 317 | call grib_check(grib_close_file(ifile)) | |
| 318 | ||
| 319 | nuvz=iumax | |
| 320 | nwz =iumax | |
| 321 | nlev_ec=iumax | |
| 322 | ||
| 323 | if (nx.gt.nxmax) then | |
| 324 | write(*,*) 'FLEXTRA error: Too many grid points in x direction.' | |
| 325 | write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC).' | |
| 326 | error=.true. | |
| 327 | return | |
| 328 | endif | |
| 329 | ||
| 330 | if (ny.gt.nymax) then | |
| 331 | write(*,*) 'FLEXTRA error: Too many grid points in y direction.' | |
| 332 | write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC).' | |
| 333 | error=.true. | |
| 334 | return | |
| 335 | endif | |
| 336 | ||
| 337 | if (nuvz.gt.nuvzmax) then | |
| 338 | write(*,*) 'FLEXTRA error: Too many u,v grid points in z '// | |
| 339 | +'direction.' | |
| 340 | write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC).' | |
| 341 | error=.true. | |
| 342 | return | |
| 343 | endif | |
| 344 | ||
| 345 | if (nwz.gt.nwzmax) then | |
| 346 | write(*,*) 'FLEXTRA error: Too many w grid points in z '// | |
| 347 | +'direction.' | |
| 348 | write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC).' | |
| 349 | error=.true. | |
| 350 | return | |
| 351 | endif | |
| 352 | ||
| 353 | C Output of grid info | |
| 354 | ********************* | |
| 355 | ||
| 356 | write(*,*) | |
| 357 | write(*,*) | |
| 358 | write(*,'(a,2i7)') '# of vertical levels: ',nuvz,nwz | |
| 359 | write(*,*) | |
| 360 | write(*,'(a)') 'Mother domain:' | |
| 361 | write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Longitude range: ', | |
| 362 | +xlon0,' to ',xlon0+(nx-1)*dx,' Grid distance: ',dx | |
| 363 | write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Latitude range: ', | |
| 364 | +ylat0,' to ',ylat0+(ny-1)*dy,' Grid distance: ',dy | |
| 365 | write(*,*) | |
| 366 | ||
| 367 | ||
| 368 | C Compute often used aux variables to convert geografical into grid coord. | |
| 369 | *************************************************************************** | |
| 370 | ||
| 371 | xthelp=180./pi/r_earth/dx | |
| 372 | ythelp=180./pi/r_earth/dy | |
| 373 | ||
| 374 | ||
| 375 | ||
| 376 | * CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL | |
| 377 | * PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM | |
| 378 | * wheight(i) IS THE HEIGHT OF THE i-th MODEL HALF LEVEL (=INTERFACE BETWEEN | |
| 379 | * 2 MODEL LEVELS) IN THE "ETA" SYSTEM | |
| 380 | ||
| 381 | numskip=nlev_ec-nuvz ! number of ecmwf model layers not used | |
| 382 | ! by trajectory model | |
| 383 | do 40 i=1,nwz | |
| 384 | j=numskip+i | |
| 385 | k=nlev_ec+1+numskip+i | |
| 386 | akm_usort(nwz-i+1)=plev(nwz-i+1) | |
| 387 | 40 bkm(nwz-i+1)=0.0 | |
| 388 | ||
| 389 | ******************************* | |
| 390 | * change Sabine Eckhardt: akm should always be in descending order ... readwind adapted! | |
| 391 | ******************************* | |
| 392 | do 41 i=1,nwz | |
| 393 | if (akm_usort(1).gt.akm_usort(2)) then | |
| 394 | akm(i)=akm_usort(i) | |
| 395 | else | |
| 396 | akm(i)=akm_usort(nwz-i+1) | |
| 397 | endif | |
| 398 | 41 continue | |
| 399 | ||
| 400 | ||
| 401 | * CALCULATION OF uvheight, akz, bkz | |
| 402 | * akz,bkz ARE THE DISCRETIZATION PARAMETERS FOR THE MODEL LEVELS | |
| 403 | * uvheight(i) IS THE HEIGHT OF THE i-th MODEL LEVEL IN THE "ETA" SYSTEM | |
| 404 | ||
| 405 | do 43 i=1,nwz | |
| 406 | 43 wheight(nwz-i+1)=akm(nwz-i+1)/p0+bkm(nwz-i+1) | |
| 407 | ||
| 408 | do 45 i=1,nuvz | |
| 409 | uvheight(i)=wheight(i) | |
| 410 | akz(i)=akm(i) | |
| 411 | bkz(i)=bkm(i) | |
| 412 | 45 continue | |
| 413 | ||
| 414 | C If vertical coordinates decrease with increasing altitude, multiply by -1. | |
| 415 | C This means that also the vertical velocities have to be multiplied by -1. | |
| 416 | **************************************************************************** | |
| 417 | ||
| 418 | if (uvheight(1).lt.uvheight(nuvz)) then | |
| 419 | zdirect=1. | |
| 420 | else | |
| 421 | zdirect=-1. | |
| 422 | do 55 i=1,nuvz | |
| 423 | 55 uvheight(i)=zdirect*uvheight(i) | |
| 424 | do 65 i=1,nwz | |
| 425 | 65 wheight(i)=zdirect*wheight(i) | |
| 426 | endif | |
| 427 | ||
| 428 | C Compute minimum and maximum height of modelling domain | |
| 429 | ******************************************************** | |
| 430 | ||
| 431 | heightmin=max(uvheight(1),wheight(1)) | |
| 432 | heightmax=min(uvheight(nuvz),wheight(nwz)) | |
| 433 | ||
| 434 | ||
| 435 | return | |
| 436 | ||
| 437 | 999 write(*,*) | |
| 438 | write(*,*) ' ###########################################'// | |
| 439 | & '###### ' | |
| 440 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE GRIDCHECK:' | |
| 441 | write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn) | |
| 442 | write(*,*) ' ###########################################'// | |
| 443 | & '###### ' | |
| 444 | error=.true. | |
| 445 | ||
| 446 | return | |
| 447 | end |
| 0 | subroutine gridcheck_nests(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine checks the grid specification for the nested model domains. * | |
| 5 | * It is similar to subroutine gridcheck, which checks the mother domain. * | |
| 6 | * * | |
| 7 | * Authors: A. Stohl, G. Wotawa * | |
| 8 | * * | |
| 9 | * 30 December 1998 * | |
| 10 | * * | |
| 11 | * Updated: * | |
| 12 | * 2011-06, implemented reading of grib2 format* | |
| 13 | * analog to FLEXPART 8.22 routines * | |
| 14 | ************************************************************************ | |
| 15 | use grib_api | |
| 16 | ||
| 17 | include 'includepar' | |
| 18 | include 'includecom' | |
| 19 | ||
| 20 | !HSO parameters for grib_api | |
| 21 | integer ifile | |
| 22 | integer iret | |
| 23 | integer igrib | |
| 24 | integer gribVer,parCat,parNum,typSurf,valSurf,discipl | |
| 25 | integer gotGrib | |
| 26 | character*24 gribErrorMsg | |
| 27 | character*20 gribFunction | |
| 28 | !HSO end | |
| 29 | ||
| 30 | integer i,j,k,l,ifn,ifield,iumax,iwmax,numskip,nlev_ecn | |
| 31 | integer nuvzn,nwzn | |
| 32 | real akmn(nwzmax),bkmn(nwzmax),akzn(nuvzmax),bkzn(nuvzmax) | |
| 33 | real uvheightn(nuvzmax),wheightn(nwzmax) | |
| 34 | real xaux1,xaux2,yaux1,yaux2 | |
| 35 | real*8 xaux1in,xaux2in,yaux1in,yaux2in | |
| 36 | logical error,oronew | |
| 37 | ||
| 38 | * VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING | |
| 39 | ||
| 40 | C dimension of isec2 at least (22+n), where n is the number of parallels or | |
| 41 | C meridians in a quasi-regular (reduced) Gaussian or lat/long grid | |
| 42 | ||
| 43 | C dimension of zsec2 at least (10+nn), where nn is the number of vertical | |
| 44 | C coordinate parameters | |
| 45 | ||
| 46 | integer isec0(2),isec1(56),isec2(22+nxmaxn+nymaxn),isec3(2) | |
| 47 | integer isec4(64),inbuff(jpack),ilen,iswap,ierr,iword,lunit | |
| 48 | real zsec2(60+2*nuvzmax),zsec3(2),zsec4(jpunp) | |
| 49 | character*1 yoper | |
| 50 | !HSO grib api error messages | |
| 51 | data gribErrorMsg/'Error reading grib file'/ | |
| 52 | data gribFunction/'gridcheck_nests'/ | |
| 53 | ||
| 54 | data yoper/'D'/ | |
| 55 | ||
| 56 | error=.false. | |
| 57 | xresoln(0)=1. ! resolution enhancement for mother grid | |
| 58 | yresoln(0)=1. ! resolution enhancement for mother grid | |
| 59 | ||
| 60 | C Loop about all nesting levels | |
| 61 | ******************************* | |
| 62 | ||
| 63 | do 300 l=1,numbnests | |
| 64 | oronew=.false. | |
| 65 | ||
| 66 | iumax=0 | |
| 67 | iwmax=0 | |
| 68 | * | |
| 69 | if(ideltas.gt.0) then | |
| 70 | ifn=1 | |
| 71 | else | |
| 72 | ifn=numbwf | |
| 73 | endif | |
| 74 | * | |
| 75 | * OPENING OF DATA FILE (GRIB CODE) | |
| 76 | * | |
| 77 | ifile=0 | |
| 78 | igrib=0 | |
| 79 | iret=0 | |
| 80 | ||
| 81 | 5 call grib_open_file(ifile,path(numpath+2*(l-1)+1) | |
| 82 | + (1:len(numpath+2*(l-1)+1))//trim(wfnamen(l,ifn)),'r',iret) | |
| 83 | if (iret.ne.GRIB_SUCCESS) then | |
| 84 | goto 999 ! ERROR DETECTED | |
| 85 | endif | |
| 86 | ||
| 87 | gotGrib=0 | |
| 88 | ifield=0 | |
| 89 | 10 ifield=ifield+1 | |
| 90 | * | |
| 91 | * GET NEXT FIELDS | |
| 92 | * | |
| 93 | call grib_new_from_file(ifile,igrib,iret) | |
| 94 | if (iret.eq.GRIB_END_OF_FILE) then | |
| 95 | goto 30 ! EOF DETECTED | |
| 96 | elseif (iret.ne.GRIB_SUCCESS) then | |
| 97 | goto 999 ! ERROR DETECTED | |
| 98 | endif | |
| 99 | ||
| 100 | ! first see if we read GRIB1 or GRIB2 | |
| 101 | call grib_get_int(igrib,'editionNumber',gribVer,iret) | |
| 102 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 103 | ||
| 104 | if (gribVer.eq.1) then ! GRIB Edition 1 | |
| 105 | c print*,'GRiB Edition 1' | |
| 106 | c read the grib2 identifiers | |
| 107 | call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret) | |
| 108 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 109 | call grib_get_int(igrib,'level',isec1(8),iret) | |
| 110 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 111 | c change code for etadot to code for omega | |
| 112 | if (isec1(6).eq.77) then | |
| 113 | isec1(6)=135 | |
| 114 | endif | |
| 115 | else | |
| 116 | c print*,'GRiB Edition 2' | |
| 117 | c read the grib2 identifiers | |
| 118 | call grib_get_int(igrib,'discipline',discipl,iret) | |
| 119 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 120 | call grib_get_int(igrib,'parameterCategory',parCat,iret) | |
| 121 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 122 | call grib_get_int(igrib,'parameterNumber',parNum,iret) | |
| 123 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 124 | call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf, | |
| 125 | + iret) | |
| 126 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 127 | call grib_get_int(igrib,'level',valSurf,iret) | |
| 128 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 129 | ||
| 130 | ! convert to grib1 identifiers | |
| 131 | isec1(6)=-1 | |
| 132 | isec1(7)=-1 | |
| 133 | isec1(8)=-1 | |
| 134 | isec1(8)=valSurf ! level | |
| 135 | if((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105))then ! T | |
| 136 | isec1(6)=130 ! indicatorOfParameter | |
| 137 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) | |
| 138 | + then ! U | |
| 139 | isec1(6)=131 ! indicatorOfParameter | |
| 140 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) | |
| 141 | + then ! V | |
| 142 | isec1(6)=132 ! indicatorOfParameter | |
| 143 | elseif((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) | |
| 144 | + then ! Q | |
| 145 | isec1(6)=133 ! indicatorOfParameter | |
| 146 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1))then !SP | |
| 147 | isec1(6)=134 ! indicatorOfParameter | |
| 148 | elseif((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot | |
| 149 | isec1(6)=135 ! indicatorOfParameter | |
| 150 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) | |
| 151 | + then !SLP | |
| 152 | isec1(6)=151 ! indicatorOfParameter | |
| 153 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) | |
| 154 | + then ! 10U | |
| 155 | isec1(6)=165 ! indicatorOfParameter | |
| 156 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) | |
| 157 | + then ! 10V | |
| 158 | isec1(6)=166 ! indicatorOfParameter | |
| 159 | elseif((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) | |
| 160 | + then ! 2T | |
| 161 | isec1(6)=167 ! indicatorOfParameter | |
| 162 | elseif((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) | |
| 163 | + then ! 2D | |
| 164 | isec1(6)=168 ! indicatorOfParameter | |
| 165 | elseif((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) | |
| 166 | + then ! SD | |
| 167 | isec1(6)=141 ! indicatorOfParameter | |
| 168 | elseif((parCat.eq.6).and.(parNum.eq.1)) then ! CC | |
| 169 | isec1(6)=164 ! indicatorOfParameter | |
| 170 | elseif((parCat.eq.1).and.(parNum.eq.9)) then ! LSP | |
| 171 | isec1(6)=142 ! indicatorOfParameter | |
| 172 | elseif((parCat.eq.1).and.(parNum.eq.10)) then ! CP | |
| 173 | isec1(6)=143 ! indicatorOfParameter | |
| 174 | elseif((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) | |
| 175 | + then ! SHF | |
| 176 | isec1(6)=146 ! indicatorOfParameter | |
| 177 | elseif((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) | |
| 178 | + then ! SR | |
| 179 | isec1(6)=176 ! indicatorOfParameter | |
| 180 | elseif((parCat.eq.2).and.(parNum.eq.17)) then ! EWSS | |
| 181 | isec1(6)=180 ! indicatorOfParameter | |
| 182 | elseif((parCat.eq.2).and.(parNum.eq.18)) then ! NSSS | |
| 183 | isec1(6)=181 ! indicatorOfParameter | |
| 184 | elseif((parCat.eq.3).and.(parNum.eq.4)) then ! ORO | |
| 185 | isec1(6)=129 ! indicatorOfParameter | |
| 186 | elseif((parCat.eq.3).and.(parNum.eq.7)) then ! SDO | |
| 187 | isec1(6)=160 ! indicatorOfParameter | |
| 188 | elseif((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. | |
| 189 | + (typSurf.eq.1)) then ! LSM | |
| 190 | isec1(6)=172 ! indicatorOfParameter | |
| 191 | else | |
| 192 | print*,'***ERROR: undefined GRiB2 message found!',discipl, | |
| 193 | + parCat,parNum,typSurf | |
| 194 | endif | |
| 195 | endif | |
| 196 | ! get the size and data of the values array | |
| 197 | if (isec1(6).ne.-1) then | |
| 198 | call grib_get_real4_array(igrib,'values',zsec4,iret) | |
| 199 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 200 | endif | |
| 201 | ||
| 202 | !HSO get the required fields from section 2 in a gribex compatible manner | |
| 203 | if (ifield.eq.1) then | |
| 204 | call grib_get_int(igrib,'numberOfPointsAlongAParallel', | |
| 205 | > isec2(2),iret) | |
| 206 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 207 | call grib_get_int(igrib,'numberOfPointsAlongAMeridian', | |
| 208 | > isec2(3),iret) | |
| 209 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 210 | call grib_get_int(igrib,'numberOfVerticalCoordinateValues', | |
| 211 | > isec2(12),iret) | |
| 212 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 213 | !HSO get the size and data of the vertical coordinate array | |
| 214 | call grib_get_real4_array(igrib,'pv',zsec2,iret) | |
| 215 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 216 | nxn(l)=isec2(2) | |
| 217 | nyn(l)=isec2(3) | |
| 218 | nlev_ecn=isec2(12)/2-1 | |
| 219 | endif ! ifield | |
| 220 | ||
| 221 | !HSO get the second part of the grid dimensions only from GRiB1 messages | |
| 222 | if ((gribVer.eq.1).and.(gotGrib.eq.0)) then | |
| 223 | call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees' | |
| 224 | + ,xaux1in,iret) | |
| 225 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 226 | call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', | |
| 227 | + xaux2in,iret) | |
| 228 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 229 | call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', | |
| 230 | + yaux1in,iret) | |
| 231 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 232 | call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', | |
| 233 | + yaux2in,iret) | |
| 234 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 235 | xaux1=xaux1in | |
| 236 | xaux2=xaux2in | |
| 237 | yaux1=yaux1in | |
| 238 | yaux2=yaux2in | |
| 239 | if(xaux1.gt.180) xaux1=xaux1-360.0 | |
| 240 | if(xaux2.gt.180) xaux2=xaux2-360.0 | |
| 241 | if(xaux1.lt.-180) xaux1=xaux1+360.0 | |
| 242 | if(xaux2.lt.-180) xaux2=xaux2+360.0 | |
| 243 | if (xaux2.lt.xaux1) xaux2=xaux2+360. | |
| 244 | xlon0n(l)=xaux1 | |
| 245 | ylat0n(l)=yaux1 | |
| 246 | dxn(l)=(xaux2-xaux1)/float(nxn(l)-1) | |
| 247 | dyn(l)=(yaux2-yaux1)/float(nyn(l)-1) | |
| 248 | gotGrib=1 | |
| 249 | endif ! ifield.eq.1 | |
| 250 | ||
| 251 | ||
| 252 | if(isec1(6).eq.129) oronew=.true. | |
| 253 | k=isec1(8) | |
| 254 | if(isec1(6).eq.131) iumax=max(iumax,nlev_ecn-k+1) | |
| 255 | if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ecn-k+1) | |
| 256 | ||
| 257 | if(isec1(6).eq.129) then | |
| 258 | do 20 j=0,nyn(l)-1 | |
| 259 | do 21 i=0,nxn(l)-1 | |
| 260 | 21 oron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga | |
| 261 | 20 continue | |
| 262 | endif | |
| 263 | ||
| 264 | call grib_release(igrib) | |
| 265 | goto 10 ! READ NEXT LEVEL OR PARAMETER | |
| 266 | * | |
| 267 | * CLOSING OF INPUT DATA FILE | |
| 268 | * | |
| 269 | 30 call grib_close_file(ifile) | |
| 270 | ||
| 271 | * error message if no fields found with correct first longitude in it | |
| 272 | if (gotGrib.eq.0) then | |
| 273 | print*,'***ERROR: input file needs to contain GRiB1 formatted' | |
| 274 | + //'messages' | |
| 275 | stop | |
| 276 | endif | |
| 277 | ||
| 278 | nuvzn=iumax | |
| 279 | nwzn=iwmax | |
| 280 | if(nuvzn.eq.nlev_ecn) nwzn=nlev_ecn+1 | |
| 281 | ||
| 282 | if (nxn(l).gt.nxmaxn) then | |
| 283 | write(*,*) 'FLEXTRA error: Too many grid points in x direction.' | |
| 284 | write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)' | |
| 285 | write(*,*) 'for nesting level ',l | |
| 286 | ||
| 287 | error=.true. | |
| 288 | return | |
| 289 | endif | |
| 290 | ||
| 291 | if (nyn(l).gt.nymaxn) then | |
| 292 | write(*,*) 'FLEXTRA error: Too many grid points in y direction.' | |
| 293 | write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)' | |
| 294 | write(*,*) 'for nesting level ',l | |
| 295 | error=.true. | |
| 296 | return | |
| 297 | endif | |
| 298 | ||
| 299 | if ((nuvzn.gt.nuvzmax).or.(nwzn.gt.nwzmax)) then | |
| 300 | write(*,*) 'FLEXTRA error: Nested wind fields have too many'// | |
| 301 | +'vertical levels.' | |
| 302 | write(*,*) 'Problem was encountered for nesting level ',l | |
| 303 | error=.true. | |
| 304 | return | |
| 305 | endif | |
| 306 | ||
| 307 | ||
| 308 | C Output of grid info | |
| 309 | ********************* | |
| 310 | ||
| 311 | write(*,'(a,i2)') 'Nested domain #: ',l | |
| 312 | write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Longitude range: ', | |
| 313 | +xlon0n(l),' to ',xlon0n(l)+(nxn(l)-1)*dxn(l), | |
| 314 | +' Grid distance: ',dxn(l) | |
| 315 | write(*,'(a,f10.2,a1,f10.2,a,f10.2)') ' Latitude range: ', | |
| 316 | +ylat0n(l),' to ',ylat0n(l)+(nyn(l)-1)*dyn(l), | |
| 317 | +' Grid distance: ',dyn(l) | |
| 318 | write(*,*) | |
| 319 | ||
| 320 | ||
| 321 | C Determine, how much the resolutions in the nests are enhanced as | |
| 322 | C compared to the mother grid | |
| 323 | ****************************************************************** | |
| 324 | ||
| 325 | xresoln(l)=dx/dxn(l) | |
| 326 | yresoln(l)=dy/dyn(l) | |
| 327 | ||
| 328 | C Determine the mother grid coordinates of the corner points of the | |
| 329 | C nested grids | |
| 330 | C Convert first to geographical coordinates, then to grid coordinates | |
| 331 | ********************************************************************* | |
| 332 | ||
| 333 | xaux1=xlon0n(l) | |
| 334 | xaux2=xlon0n(l)+float(nxn(l)-1)*dxn(l) | |
| 335 | yaux1=ylat0n(l) | |
| 336 | yaux2=ylat0n(l)+float(nyn(l)-1)*dyn(l) | |
| 337 | ||
| 338 | xln(l)=(xaux1-xlon0)/dx | |
| 339 | xrn(l)=(xaux2-xlon0)/dx | |
| 340 | yln(l)=(yaux1-ylat0)/dy | |
| 341 | yrn(l)=(yaux2-ylat0)/dy | |
| 342 | ||
| 343 | ||
| 344 | * CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL | |
| 345 | * PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM | |
| 346 | * wheight(i) IS THE HEIGHT OF THE i-th MODEL HALF LEVEL (=INTERFACE BETWEEN | |
| 347 | * 2 MODEL LEVELS) IN THE "ETA" SYSTEM | |
| 348 | ||
| 349 | numskip=nlev_ecn-nuvzn ! number of ECMWF model layers not used | |
| 350 | ! by trajectory model | |
| 351 | do 40 i=1,nwzn | |
| 352 | j=numskip+i | |
| 353 | k=nlev_ecn+1+numskip+i | |
| 354 | akmn(nwzn-i+1)=zsec2(j) | |
| 355 | bkmn(nwzn-i+1)=zsec2(k) | |
| 356 | 40 wheightn(nwzn-i+1)=akmn(nwzn-i+1)/p0+bkmn(nwzn-i+1) | |
| 357 | ||
| 358 | * CALCULATION OF uvheight, akz, bkz | |
| 359 | * akz,bkz ARE THE DISCRETIZATION PARAMETERS FOR THE MODEL LEVELS | |
| 360 | * uvheight(i) IS THE HEIGHT OF THE i-th MODEL LEVEL IN THE "ETA" SYSTEM | |
| 361 | ||
| 362 | do 45 i=1,nuvzn | |
| 363 | uvheightn(i)=0.5*(wheightn(i+1)+wheightn(i)) | |
| 364 | akzn(i)=0.5*(akmn(i+1)+akmn(i)) | |
| 365 | 45 bkzn(i)=0.5*(bkmn(i+1)+bkmn(i)) | |
| 366 | ||
| 367 | ||
| 368 | C If vertical coordinates decrease with increasing altitude, multiply by -1. | |
| 369 | C This means that also the vertical velocities have to be multiplied by -1. | |
| 370 | **************************************************************************** | |
| 371 | ||
| 372 | if (uvheightn(1).lt.uvheightn(nuvzn)) then | |
| 373 | zdirect=1. | |
| 374 | else | |
| 375 | zdirect=-1. | |
| 376 | do 55 i=1,nuvz | |
| 377 | 55 uvheightn(i)=zdirect*uvheightn(i) | |
| 378 | do 65 i=1,nwz | |
| 379 | 65 wheightn(i)=zdirect*wheightn(i) | |
| 380 | endif | |
| 381 | ||
| 382 | ||
| 383 | C Check, whether the heights of the model levels of the nested | |
| 384 | C wind fields are consistent with those of the mother domain. | |
| 385 | C If not, terminate model run. | |
| 386 | ************************************************************** | |
| 387 | ||
| 388 | do 75 i=1,nuvz | |
| 389 | if ((akzn(i).ne.akz(i)).or.(bkzn(i).ne.bkz(i)).or. | |
| 390 | + (uvheightn(i).ne.uvheight(i))) then | |
| 391 | write(*,*) 'FLEXTRA error: The wind fields of nesting level',l | |
| 392 | write(*,*) 'are not consistent with the mother domain:' | |
| 393 | write(*,*) 'Differences in vertical levels detected.' | |
| 394 | error=.true. | |
| 395 | return | |
| 396 | endif | |
| 397 | 75 continue | |
| 398 | ||
| 399 | do 85 i=1,nwz | |
| 400 | if ((akmn(i).ne.akm(i)).or.(bkmn(i).ne.bkm(i)).or. | |
| 401 | + (wheightn(i).ne.wheight(i))) then | |
| 402 | write(*,*) 'FLEXTRA error: The wind fields of nesting level',l | |
| 403 | write(*,*) 'are not consistent with the mother domain:' | |
| 404 | write(*,*) 'Differences in vertical levels detected.' | |
| 405 | error=.true. | |
| 406 | return | |
| 407 | endif | |
| 408 | 85 continue | |
| 409 | ||
| 410 | if (.not.oronew) then | |
| 411 | write(*,*) 'FLEXTRA error: Orography of nested domains' | |
| 412 | write(*,*) 'is missing in the wind field files.' | |
| 413 | endif | |
| 414 | ||
| 415 | 300 continue | |
| 416 | return | |
| 417 | ||
| 418 | ||
| 419 | 999 write(*,*) | |
| 420 | write(*,*) ' ###########################################'// | |
| 421 | & '###### ' | |
| 422 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE GRIDCHECK:' | |
| 423 | write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfnamen(l,ifn) | |
| 424 | write(*,*) ' FOR NESTING LEVEL ',k | |
| 425 | write(*,*) ' ###########################################'// | |
| 426 | & '###### ' | |
| 427 | error=.true. | |
| 428 | ||
| 429 | return | |
| 430 | end |
| 0 | subroutine gridcheck_nests(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine checks the grid specification for the nested model domains. * | |
| 5 | * It is similar to subroutine gridcheck, which checks the mother domain. * | |
| 6 | * * | |
| 7 | * Authors: A. Stohl, G. Wotawa * | |
| 8 | * * | |
| 9 | * 30 December 1998 * | |
| 10 | ******************************************************************************** | |
| 11 | ||
| 12 | include 'includepar' | |
| 13 | include 'includecom' | |
| 14 | ||
| 15 | logical error | |
| 16 | ||
| 17 | if (numbnests.ne.0) | |
| 18 | + stop 'FLEXTRA GFS cannot be operated with nested windfields' | |
| 19 | ||
| 20 | end |
| 0 | ******************************************************************************** | |
| 1 | * Include file for calculation of trajectories (Program FLEXTRA) * | |
| 2 | * This file contains a global common block used in FLEXTRA * | |
| 3 | * * | |
| 4 | * Authors: A. Stohl, G. Wotawa * | |
| 5 | * * | |
| 6 | * 1 February 1994 * | |
| 7 | * Update: December 1998, A. Stohl * | |
| 8 | * * | |
| 9 | ******************************************************************************** | |
| 10 | ||
| 11 | ||
| 12 | C Variables needed for polar stereographic projection | |
| 13 | ***************************************************** | |
| 14 | ||
| 15 | logical xglobal,sglobal,nglobal | |
| 16 | real switchnorthg,switchsouthg | |
| 17 | ||
| 18 | C xglobal T for global fields, F for limited area fields | |
| 19 | C sglobal T if domain extends towards south pole | |
| 20 | C nglobal T if domain extends towards north pole | |
| 21 | C switchnorthg,switchsouthg same as parameters switchnorth, | |
| 22 | C switchsouth, but in grid units | |
| 23 | ||
| 24 | real southpolemap(9),northpolemap(9) | |
| 25 | ||
| 26 | C southpolemap,northpolemap define stereographic projections | |
| 27 | C at the two poles | |
| 28 | ||
| 29 | ||
| 30 | C Variables needed for nested grids | |
| 31 | *********************************** | |
| 32 | ||
| 33 | integer numbnests | |
| 34 | ||
| 35 | C numbnests number of nested grids | |
| 36 | ||
| 37 | character*18 wfnamen(maxnests,numbwfmax) | |
| 38 | character*18 wfspecn(maxnests,numbwfmax) | |
| 39 | ||
| 40 | C wfnamen nested wind field names | |
| 41 | C wfspecn specifications of wind field file, e.g. if on hard | |
| 42 | C disc or on tape | |
| 43 | ||
| 44 | ||
| 45 | integer nxn(maxnests),nyn(maxnests) | |
| 46 | real dxn(maxnests),dyn(maxnests),xlon0n(maxnests),ylat0n(maxnests) | |
| 47 | ||
| 48 | C nxn,nyn actual dimensions of nested wind fields in x and y direction | |
| 49 | C dxn,dyn grid distances in x,y direction for the nested grids | |
| 50 | C xlon0n geographical longitude of lower left grid point of nested wind fields | |
| 51 | C ylat0n geographical latitude of lower left grid point of nested wind fields | |
| 52 | ||
| 53 | ||
| 54 | real uun(0:nxmaxn-1,0:nymaxn-1,nuvzmax,3,maxnests) | |
| 55 | real vvn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,3,maxnests) | |
| 56 | real wwn(0:nxmaxn-1,0:nymaxn-1,nwzmax,3,maxnests) | |
| 57 | real ttn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,3,maxnests) | |
| 58 | real qqn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,3,maxnests) | |
| 59 | real pvn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,3,maxnests) | |
| 60 | real thn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,3,maxnests) | |
| 61 | real psn(0:nxmaxn-1,0:nymaxn-1,1,3,maxnests) | |
| 62 | real oron(0:nxmaxn-1,0:nymaxn-1,maxnests) | |
| 63 | ||
| 64 | C uun,vvn,wwn nested wind data in x,y and z direction | |
| 65 | C psn nested surface pressure | |
| 66 | C oron [m] nested orography of the ECMWF model | |
| 67 | C ttn, qqn nested temperature and specific humidity | |
| 68 | C pvn, thn nested potential vorticity and potential temperature | |
| 69 | ||
| 70 | ||
| 71 | real xresoln(0:maxnests),yresoln(0:maxnests) | |
| 72 | ||
| 73 | C xresoln, yresoln Factors by which the resolutions in the nests | |
| 74 | C are enhanced compared to mother grid | |
| 75 | ||
| 76 | real xln(maxnests),yln(maxnests),xrn(maxnests),yrn(maxnests) | |
| 77 | ||
| 78 | C xln,yln,xrn,yrn Corner points of nested grids in grid coordinates | |
| 79 | C of mother grid | |
| 80 | ||
| 81 | ||
| 82 | ||
| 83 | integer nx,ny,nxfield,nuvz,nwz,nlev_ec | |
| 84 | ||
| 85 | C nx,ny,nuvz,nwz actual dimensions of wind fields in x,y and z | |
| 86 | C direction, respectively | |
| 87 | ||
| 88 | C nxfield same as nx for limited area fields, | |
| 89 | C but for global fields nx=nxfield+1 | |
| 90 | ||
| 91 | C nuvz is used for u,v components | |
| 92 | C nwz is used for w components (staggered grid) | |
| 93 | C nlev_ec number of levels ECMWF model | |
| 94 | ||
| 95 | integer inter,interstep,ldim,numbunc,inpolkind,modecet | |
| 96 | ||
| 97 | C inter index, if trajectory output with constant time step | |
| 98 | C interstep time step for trajectory output | |
| 99 | C ldim number of steps along the interpolated trajectory | |
| 100 | C numbunc number of uncertainty trajectories | |
| 101 | C inpolkind index for kind of interpolation (spline or linear) | |
| 102 | C modecet 1 = CET mode switched off, 2 = CET mode switched on | |
| 103 | ||
| 104 | character*50 runcomment | |
| 105 | ||
| 106 | C runcomment identification comment for the model run | |
| 107 | ||
| 108 | real cfl,cflt | |
| 109 | ||
| 110 | C* cfl CFL-criterion horizontal and vertical | |
| 111 | C* cflt CFL-criterion time | |
| 112 | ||
| 113 | real distunc | |
| 114 | ||
| 115 | C distunc distance (grid units) of uncertainty t. from main one | |
| 116 | ||
| 117 | integer ldirect | |
| 118 | ||
| 119 | C ldirect direction of the trajectories (-1=backward,1=forward) | |
| 120 | ||
| 121 | integer numpoint | |
| 122 | ||
| 123 | C numpoint actual number of trajectory starting/ending points | |
| 124 | ||
| 125 | integer lentra,ibdate,ibtime,iedate,ietime,interv | |
| 126 | ||
| 127 | ||
| 128 | C lentra length of trajectory (s) | |
| 129 | C ibdate beginning date (YYYYMMDD) | |
| 130 | C ibtime beginning time (HHMISS) | |
| 131 | C iedate ending date (YYYYMMDD) | |
| 132 | C ietime ending time (HHMISS) | |
| 133 | C interv interval of trajectory calculation (s) | |
| 134 | ||
| 135 | integer len(numpath+2*maxnests) | |
| 136 | ||
| 137 | C len length of path names needed for trajectory model | |
| 138 | ||
| 139 | integer ideltas,nextflight | |
| 140 | ||
| 141 | C ideltas length of trajectory loop from beginning to | |
| 142 | C ending date (s) | |
| 143 | C nextflight next time, when initialization of FLIGHT | |
| 144 | C trajectories is due (s) | |
| 145 | ||
| 146 | real epsu,epsv,epsw,relaxtime | |
| 147 | ||
| 148 | C epsu,epsv,epsw magnitude of the relative random errors that are | |
| 149 | C added to the wind components of the ensemble | |
| 150 | C uncertainty trajectories at each time step | |
| 151 | C relaxtime time constant (in units of the wind field interval) | |
| 152 | C at which the above errors are relaxed using | |
| 153 | C a Langevin equation | |
| 154 | ||
| 155 | ||
| 156 | integer numbwf,wftime(numbwfmax) | |
| 157 | character*18 wfname(numbwfmax) | |
| 158 | character*10 wfspec(numbwfmax) | |
| 159 | ||
| 160 | C numbwf actual number of wind fields | |
| 161 | C wftime(numbwfmax) [s] times relative to beginning time of wind fields | |
| 162 | C wfname(numbwfmax) file names of wind fields | |
| 163 | C wfspec(numbwfmax) specifications of wind field file, e.g. if on hard | |
| 164 | C disc or on tape | |
| 165 | ||
| 166 | ||
| 167 | real akm(nwzmax), bkm(nwzmax) | |
| 168 | real akz(nuvzmax) , bkz(nuvzmax) | |
| 169 | ||
| 170 | * akm,bkm: coeffizients which regulate vertical discretization of ecmwf model | |
| 171 | * (at the border of model layers) | |
| 172 | * akz,bkz: model discretization coeffizients at the centre of the layers | |
| 173 | ||
| 174 | ||
| 175 | integer memtime(3),memind(3) | |
| 176 | ||
| 177 | C memind pointer, at which position the wind fields are actually stored | |
| 178 | C in memory | |
| 179 | C memtime times of the fields stored in memory | |
| 180 | ||
| 181 | real uu(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 182 | real vv(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 183 | real uupol(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 184 | real vvpol(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 185 | real ww(0:nxmax-1,0:nymax-1,nwzmax,3) | |
| 186 | real tt(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 187 | real qq(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 188 | real pv(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 189 | real th(0:nxmax-1,0:nymax-1,nuvzmax,3) | |
| 190 | real ps(0:nxmax-1,0:nymax-1,1,3) | |
| 191 | real oro(0:nxmax-1,0:nymax-1) | |
| 192 | ||
| 193 | C uu,vv,ww wind data in x,y and z direction (grid values) | |
| 194 | C uupol,vvpol horizontal wind transformed onto a polarstereographic grid | |
| 195 | C tt, qq temperature and specific humidity | |
| 196 | C pv, th potential vorticity and potential temperature | |
| 197 | C ps surface pressure | |
| 198 | C oro [m] orography of the ECMWF model | |
| 199 | ||
| 200 | real xpoint(maxtra),ypoint(maxtra),zpoint(maxtra) | |
| 201 | ||
| 202 | C xpoint x-coordinates of starting/ending points | |
| 203 | C ypoint y-coordinates of starting/ending points | |
| 204 | C zpoint z-coordinates of starting/ending points | |
| 205 | ||
| 206 | real dx,dy,xlon0,ylat0,xthelp,ythelp | |
| 207 | real uvheight(nuvzmax),wheight(nwzmax),heightmin,heightmax | |
| 208 | ||
| 209 | C dx grid distance in x direction | |
| 210 | C dy grid distance in y direction | |
| 211 | C uvheight heights of (u,v) gridpoints | |
| 212 | C wheight heights of (w) gridpoints | |
| 213 | C xlon0 geographical longitude of lower left grid point | |
| 214 | C ylat0 geographical latitude of lower left grid point | |
| 215 | C heightmin, heightmax minimum and maximum height of modelling domain | |
| 216 | C xthelp,ythelp help variables to convert geografical coordinates | |
| 217 | C into grid coordinates | |
| 218 | ||
| 219 | real zdirect | |
| 220 | ||
| 221 | C zdirect direction of model levels from bottom to top | |
| 222 | C if coordinate of first model level (bottom) is | |
| 223 | C less then coordinate of last model level, | |
| 224 | C zdirect is set 1. Otherwise, it is set -1 | |
| 225 | ||
| 226 | integer numtra,nttra(maxtra),npoint(maxtra) | |
| 227 | integer kind(maxtra),kindz(maxtra) | |
| 228 | real randerroru(maxtra),randerrorv(maxtra),randerrorw(maxtra) | |
| 229 | integer ittra(maxtra,maxtime),ittraint(maxitime) | |
| 230 | real xtra(maxtra,maxtime),ytra(maxtra,maxtime), | |
| 231 | & ztra(maxtra,maxtime),ptra(maxtra,maxtime), | |
| 232 | & htra(maxtra,maxtime),pvtra(maxtra,maxtime), | |
| 233 | & thtra(maxtra,maxtime),qqtra(maxtra,maxtime) | |
| 234 | real xtraint(maxitime),ytraint(maxitime),ztraint(maxitime), | |
| 235 | + ptraint(maxitime),htraint(maxitime),pvtraint(maxitime), | |
| 236 | + thtraint(maxitime),qqtraint(maxitime) | |
| 237 | ||
| 238 | C numtra actual number of trajectories in memory | |
| 239 | C nttra(maxtra) number of time steps that are already computed | |
| 240 | C npoint(maxtra) identification of startpoint of trajectory | |
| 241 | C kind(maxtra) index for kind of trajectories (e.g. isobaric, 3-d,..) | |
| 242 | C randerroru,randerrorv, Random errors added to the trajectory during | |
| 243 | C randerrorw last time step | |
| 244 | C kindz(maxtra) indicates the unit of the z coordinate (1: masl, | |
| 245 | C 2: magl, 3: hPa) | |
| 246 | C htra,ptra height in meters and in hPa | |
| 247 | C xtra,ytra,ztra spatial positions of the trajectories | |
| 248 | C qqtra specific humidity along trajectories | |
| 249 | C qqtraint specific humidity interpolated to constant time step | |
| 250 | C thtra(maxtra,maxtime) [K] potential temperature along trajectory | |
| 251 | C thtraint(maxitime) [K] potential temperature interpolated to constant step | |
| 252 | c pvtra(maxtra,maxtime) [Ks-1hPa-1] potential vorticity along trajectory | |
| 253 | c pvtraint(maxtra,maxtime) [Ks-1hPa-1] potential vorticity interpolated to constant step | |
| 254 | C ittra (maxtra,maxtime) [s] temporal position of the trajectories | |
| 255 | C ittraint(maxitime) [s] one trajectory interpolated to constant time step | |
| 256 | C xtraint,ytraint,ztraint one trajectory interpolated to constant time step | |
| 257 | ||
| 258 | ||
| 259 | double precision bdate | |
| 260 | ||
| 261 | C bdate beginning date of trajectory loop (julian date) | |
| 262 | ||
| 263 | character path(numpath+2*maxnests)*80 | |
| 264 | ||
| 265 | C path path names needed for trajectory model | |
| 266 | ||
| 267 | character compoint(maxtra)*45 | |
| 268 | ||
| 269 | C compoint comment - characterization of starting point | |
| 270 | ||
| 271 | common /global1/ | |
| 272 | +bdate, | |
| 273 | +nx,ny,nuvz,nwz,numbwf,wftime,inter,interstep,ldim,numbunc,modecet, | |
| 274 | +inpolkind,ldirect,kind,kindz,lentra,ibdate,ibtime,iedate,ietime, | |
| 275 | +interv,len,numpoint,ideltas,ittra,ittraint,numtra,nttra,npoint, | |
| 276 | +memtime,memind,nxfield,nlev_ec,nextflight, | |
| 277 | +randerroru,randerrorv,randerrorw | |
| 278 | ||
| 279 | common /global2/ | |
| 280 | +xtra,ytra,ztra,ptra,qqtra,htra,xtraint,ytraint,ztraint,ptraint, | |
| 281 | +qqtraint,htraint, | |
| 282 | +cfl,cflt,distunc,akm,bkm,akz,bkz,pvtra,pvtraint,thtra, | |
| 283 | +thtraint,uu,vv,uupol,vvpol,ww,tt,qq,pv,th,ps,oro, | |
| 284 | +switchsouthg,switchnorthg,northpolemap,southpolemap, | |
| 285 | +xpoint,ypoint,zpoint,epsu,epsv,epsw,relaxtime, | |
| 286 | +dx,dy,uvheight,wheight,heightmin,heightmax,xlon0,ylat0, | |
| 287 | +xthelp,ythelp,zdirect,xglobal,sglobal,nglobal | |
| 288 | ||
| 289 | common /global3/ | |
| 290 | +path,wfname,wfspec,compoint,runcomment | |
| 291 | ||
| 292 | common /global4/ | |
| 293 | +numbnests,nxn,nyn,uun,vvn,wwn,ttn,qqn,pvn,thn,psn,oron, | |
| 294 | +xlon0n,ylat0n,dxn,dyn,xresoln,yresoln,xln,yln,xrn,yrn, | |
| 295 | +wfnamen,wfspecn |
| 0 | ******************************************************************************** | |
| 1 | * Include file for calculation of trajectories (Program FLEXTRA) * | |
| 2 | * This file contains the parameter statements used in FLEXTRA * | |
| 3 | * * | |
| 4 | * Authors: A. Stohl, G. Wotawa * | |
| 5 | * * | |
| 6 | * 1 February 1994 * | |
| 7 | * Update: December 1998, A. Stohl * | |
| 8 | * * | |
| 9 | ******************************************************************************** | |
| 10 | ||
| 11 | implicit none | |
| 12 | ||
| 13 | real pi,p0,kappa,eps,eps1 | |
| 14 | parameter(pi=3.14159265,p0=101325,kappa=0.286,eps=1.e-5) | |
| 15 | parameter(eps1=1.e-30) | |
| 16 | ||
| 17 | C number "pi" | |
| 18 | C eps = tiny number | |
| 19 | C kappa = exponent of formula for potential temperature | |
| 20 | C p0 = parameter for calculation of vertical coordinate eta (ECMWF) | |
| 21 | ||
| 22 | real xmwml | |
| 23 | parameter(xmwml=18.016/28.960) | |
| 24 | ||
| 25 | * xmwml ratio of molar weights of water vapor and dry air | |
| 26 | ||
| 27 | real r_earth,r_air,ga | |
| 28 | ||
| 29 | parameter(r_earth=6.371e6,r_air=287.05,ga=9.81) | |
| 30 | ||
| 31 | C r_earth radius of earth [m] | |
| 32 | C r_air individual gas constant for dry air [J/kg/K] | |
| 33 | C ga gravity acceleration of earth [m/s**2] | |
| 34 | ||
| 35 | ||
| 36 | integer nxmax,nymax,nuvzmax,nwzmax | |
| 37 | parameter(nxmax=361,nymax=181,nuvzmax=92,nwzmax=92) | |
| 38 | ||
| 39 | C nxmax,nymax maximum dimension of wind fields in x and y | |
| 40 | C direction, respectively | |
| 41 | C nuvzmax,nwzmax maximum dimension of (u,v) and (w) wind fields in z | |
| 42 | C direction | |
| 43 | ||
| 44 | integer itermax | |
| 45 | parameter(itermax=50) | |
| 46 | ||
| 47 | C itermax Maximum number of iterations in integration | |
| 48 | C scheme of trajectory equation | |
| 49 | ||
| 50 | integer numpath | |
| 51 | parameter(numpath=4) | |
| 52 | ||
| 53 | C numpath Number of different pathnames for input/output files | |
| 54 | ||
| 55 | integer numbwfmax | |
| 56 | parameter(numbwfmax=15000) | |
| 57 | ||
| 58 | C numbwfmax maximum number of windfields | |
| 59 | ||
| 60 | ||
| 61 | real deltahormax,deltavermax | |
| 62 | parameter(deltahormax=0.0001,deltavermax=0.0001) | |
| 63 | ||
| 64 | C deltahormax Maximum horizontal distance between two iterations | |
| 65 | C of the integration scheme | |
| 66 | C deltavermax Maximum vertical distance between two iterations | |
| 67 | C of the integration scheme | |
| 68 | ||
| 69 | integer maxpoint | |
| 70 | c parameter(maxpoint=160) | |
| 71 | parameter(maxpoint= 50) | |
| 72 | ||
| 73 | C maxpoint Maximum number of trajectory starting/ending | |
| 74 | C points | |
| 75 | ||
| 76 | integer maxtra,maxtime,maxitime | |
| 77 | parameter(maxtra=100*maxpoint) | |
| 78 | parameter(maxtime=1500,maxitime=10000) | |
| 79 | ||
| 80 | C maxtra maximum number of simultaneously calculated trajectories | |
| 81 | C maxtime maximum number of trajectory timesteps | |
| 82 | C maxitime maximum number of equidistant interpolated time steps | |
| 83 | ||
| 84 | integer idiffnorm,idiffmax | |
| 85 | parameter(idiffnorm=21600) | |
| 86 | parameter(idiffmax=2*idiffnorm) | |
| 87 | ||
| 88 | C idiffnorm normal time difference between two windfields | |
| 89 | C idiffmax maximum time difference between two windfields | |
| 90 | ||
| 91 | integer unitpath,unitcommand,unitgrid,unitavailab | |
| 92 | integer unitpoin,unitwind,unittraj,unittraji | |
| 93 | integer unitvert,unitoro | |
| 94 | parameter(unitpath=1,unitcommand=1,unitgrid=1) | |
| 95 | parameter(unitavailab=1,unitpoin=1,unitwind=1) | |
| 96 | parameter(unitvert=1,unitoro=1) | |
| 97 | parameter(unittraj=70,unittraji=8) | |
| 98 | ||
| 99 | ||
| 100 | C Parameters for GRIB file decoding | |
| 101 | *********************************** | |
| 102 | ||
| 103 | integer jpack,jpunp | |
| 104 | ||
| 105 | parameter(jpack=4*nxmax*nymax,jpunp=4*jpack) | |
| 106 | ||
| 107 | ||
| 108 | C Parameters for polar stereographic projection close to the poles | |
| 109 | ****************************************************************** | |
| 110 | ||
| 111 | real switchnorth,switchsouth | |
| 112 | parameter(switchnorth=75.,switchsouth=-75.) | |
| 113 | ||
| 114 | C switchnorth use polar stereographic grid north of switchnorth | |
| 115 | C switchsouth use polar stereographic grid south of switchsouth | |
| 116 | ||
| 117 | ||
| 118 | C Parameters for nested grids | |
| 119 | ***************************** | |
| 120 | ||
| 121 | integer maxnests | |
| 122 | parameter(maxnests=1) | |
| 123 | ||
| 124 | C maxnests maximum number of nested grids | |
| 125 | ||
| 126 | integer nxmaxn,nymaxn | |
| 127 | parameter(nxmaxn=251,nymaxn=151) | |
| 128 | ||
| 129 | C nxmaxn,nymaxn maximum dimension of nested wind fields in | |
| 130 | C x and y direction, respectively |
| 0 | subroutine inter3d(xt,yt,zt,indexf,itime,init,firststep, | |
| 1 | +iter,lkindz,ngrid,uint,vint,dzdt,indwz) | |
| 2 | C i i i i i i i | |
| 3 | C i i i o o o o | |
| 4 | ******************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation routine for 3-dimensional trajectories. * | |
| 7 | * * | |
| 8 | * Author: A. Stohl * | |
| 9 | * * | |
| 10 | * 27 April 1994 * | |
| 11 | * * | |
| 12 | * Update: 23 December 1998 (Use of global domain and nesting) * | |
| 13 | * * | |
| 14 | ******************************************************************************** | |
| 15 | * * | |
| 16 | * Variables: * | |
| 17 | * dzdt wind components in grid units per second * | |
| 18 | * firstep .true. for first iteration of petterssen * | |
| 19 | * idiff [s] Temporal distance between the windfields used for interpol* | |
| 20 | * indwz index of the model layer beneath current position of traj.* | |
| 21 | * init .true. for first time step of trajectory * | |
| 22 | * iter number of time iteration step * | |
| 23 | * itime [s] current temporal position * | |
| 24 | * memtime(3) [s] times for the wind fields in memory * | |
| 25 | * ngrid index which grid is to be used * | |
| 26 | * nstop =greater 0, if trajectory calculation is finished * | |
| 27 | * uint,vint,wint [m/s] interpolated wind components * | |
| 28 | * xt,yt,zt coordinates position for which wind data shall be calculat* | |
| 29 | * * | |
| 30 | ******************************************************************************** | |
| 31 | ||
| 32 | include 'includepar' | |
| 33 | include 'includecom' | |
| 34 | ||
| 35 | integer i,itime,indexf,indwz,iter,lkindz,ngrid | |
| 36 | real xt,yt,zt,dzdt,uint,vint,wint,psint,eta,xtn,ytn | |
| 37 | logical firststep,init | |
| 38 | ||
| 39 | ||
| 40 | C Determine nested grid coordinates | |
| 41 | *********************************** | |
| 42 | ||
| 43 | if (ngrid.gt.0) then | |
| 44 | xtn=(xt-xln(ngrid))*xresoln(ngrid) | |
| 45 | ytn=(yt-yln(ngrid))*yresoln(ngrid) | |
| 46 | endif | |
| 47 | ||
| 48 | C Calculate the surface pressure. | |
| 49 | ********************************* | |
| 50 | ||
| 51 | if (ngrid.gt.0) then ! nested grid | |
| 52 | call levlininterpoln(psn,maxnests,nxmaxn,nymaxn,1,ngrid,nxn,nyn, | |
| 53 | + memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1),itime, | |
| 54 | + indexf,psint) | |
| 55 | else ! mother grid | |
| 56 | call levlininterpol(ps,nxmax,nymax,1,nx,ny,memind,xt,yt, | |
| 57 | + 1,memtime(indexf),memtime(indexf+1),itime,indexf,psint) | |
| 58 | endif | |
| 59 | ||
| 60 | ||
| 61 | C For a new trajectory and the first iteration of petterssen: | |
| 62 | C Transformation from height in [m] coordinate to height in eta coordinate. | |
| 63 | C Or: transformation from height in [Pa] to height in eta coordinate. | |
| 64 | *************************************************************************** | |
| 65 | ||
| 66 | if (init.and.firststep) then | |
| 67 | if ((lkindz.eq.1).or.(lkindz.eq.2)) then | |
| 68 | if (ngrid.gt.0) then ! nested grid | |
| 69 | call etatrafo(xtn,ytn,zt,memtime(indexf),memtime(indexf+1), | |
| 70 | + itime,indexf,ngrid,psint) | |
| 71 | else ! mother grid | |
| 72 | call etatrafo(xt,yt,zt,memtime(indexf),memtime(indexf+1), | |
| 73 | + itime,indexf,ngrid,psint) | |
| 74 | endif | |
| 75 | else if (lkindz.eq.3) then | |
| 76 | zt=eta(psint,zt) | |
| 77 | endif | |
| 78 | endif | |
| 79 | ||
| 80 | ||
| 81 | C Calculate index of (w) layers between the trajectory point is situated. | |
| 82 | C Trajectory point is located between wheight(indwz) and wheight(indwz+1) | |
| 83 | ************************************************************************* | |
| 84 | ||
| 85 | do 95 i=2,nwz | |
| 86 | if (wheight(i).ge.zt) goto 96 | |
| 87 | 95 continue | |
| 88 | 96 indwz=i-1 | |
| 89 | ||
| 90 | ||
| 91 | ||
| 92 | C Interpolation of wind field data is done. | |
| 93 | C Either linear interpolation (if selected and for first iteration | |
| 94 | C of petterssen) or bicubic interpolation | |
| 95 | ******************************************* | |
| 96 | ||
| 97 | if (ngrid.eq.0) then ! mother grid | |
| 98 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 99 | call interpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 100 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,uint) | |
| 101 | call interpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 102 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,vint) | |
| 103 | call interpol(ww,nxmax,nymax,nwzmax,nx,ny,nwz,memind,wheight, | |
| 104 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,wint) | |
| 105 | else ! bilinear interpolation | |
| 106 | call lininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 107 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 108 | + indexf,uint) | |
| 109 | call lininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 110 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 111 | + indexf,vint) | |
| 112 | call lininterpol(ww,nxmax,nymax,nwzmax,nx,ny,nwz,memind, | |
| 113 | + wheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 114 | + indexf,wint) | |
| 115 | endif | |
| 116 | ||
| 117 | else if (ngrid.gt.0) then ! nested grid | |
| 118 | ||
| 119 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 120 | call interpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 121 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 122 | + memtime(indexf+1),itime,indexf,uint) | |
| 123 | call interpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 124 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 125 | + memtime(indexf+1),itime,indexf,vint) | |
| 126 | call interpoln(wwn,maxnests,nxmaxn,nymaxn,nwzmax, | |
| 127 | + ngrid,nxn,nyn,nwz,memind,wheight,xtn,ytn,zt,memtime(indexf), | |
| 128 | + memtime(indexf+1),itime,indexf,wint) | |
| 129 | ||
| 130 | else ! bilinear interpolation | |
| 131 | call lininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 132 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 133 | + memtime(indexf+1),itime,indexf,uint) | |
| 134 | call lininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 135 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 136 | + memtime(indexf+1),itime,indexf,vint) | |
| 137 | call lininterpoln(wwn,maxnests,nxmaxn,nymaxn,nwzmax, | |
| 138 | + ngrid,nxn,nyn,nwz,memind,wheight,xtn,ytn,zt,memtime(indexf), | |
| 139 | + memtime(indexf+1),itime,indexf,wint) | |
| 140 | endif | |
| 141 | ||
| 142 | else ! polar stereographic grid | |
| 143 | ! only linear interpolation used | |
| 144 | ||
| 145 | call lininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 146 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 147 | + indexf,uint) | |
| 148 | call lininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 149 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 150 | + indexf,vint) | |
| 151 | call lininterpol(ww,nxmax,nymax,nwzmax,nx,ny,nwz,memind, | |
| 152 | + wheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 153 | + indexf,wint) | |
| 154 | endif | |
| 155 | ||
| 156 | ||
| 157 | call wtransform(wint,psint,zt,indwz,dzdt) | |
| 158 | ||
| 159 | return | |
| 160 | end |
| 0 | subroutine interisentrop(xt,yt,zt,thetaconst,indexf,itime,init, | |
| 1 | +firststep,iter,lkindz,ngrid,uint,vint) | |
| 2 | C i i i/o i/o i i i | |
| 3 | C i i i i o o | |
| 4 | ******************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation routine for isentropic trajectories. * | |
| 7 | * * | |
| 8 | * The user gives the vertical coordinate in metres. In the first time step of * | |
| 9 | * the trajectory, metres are transformed to Kelvin. In all time steps these * | |
| 10 | * Kelvin are kept constant and transformed onward to the eta coordinate. * | |
| 11 | * * | |
| 12 | * * | |
| 13 | * Author: A. Stohl * | |
| 14 | * * | |
| 15 | * 27 April 1994 * | |
| 16 | * * | |
| 17 | * Update: 23 December 1998 (Use of global domain and nesting) * | |
| 18 | * * | |
| 19 | ******************************************************************************** | |
| 20 | * * | |
| 21 | * Variables: * | |
| 22 | * firststep .true. for first step of petterssen, .false. for iteration* | |
| 23 | * idiff [s] Temporal distance between the windfields used for interpol* | |
| 24 | * indz1,indz2 indices of boundary of unstable region * | |
| 25 | * init .true. for first time step of trajectory, .false. for othe* | |
| 26 | * iter number of iteration step * | |
| 27 | * itime [s] current temporal position * | |
| 28 | * lkindz unit of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 29 | * memtime(3) [s] times of the wind fields in memory * | |
| 30 | * ngrid index which grid is to be used * | |
| 31 | * nstop =greater 0, if trajectory calculation is finished * | |
| 32 | * psint [Pa] interpolated surface pressure * | |
| 33 | * temp [K] temperature at trajectory position * | |
| 34 | * thetaconst [Pa] theta level, for which trajectories shall be calculated * | |
| 35 | * uint,vint [m/s] interpolated wind components * | |
| 36 | * uvheight heights in which u,v and t are given * | |
| 37 | * xt,yt,zt coordinates position for which wind data shall be calculat* | |
| 38 | * * | |
| 39 | * Constants: * | |
| 40 | * kappa exponent for calculating potential temperature * | |
| 41 | * * | |
| 42 | * Function: * | |
| 43 | * pp calculates the pressure at a given eta level * | |
| 44 | * * | |
| 45 | ******************************************************************************** | |
| 46 | ||
| 47 | include 'includepar' | |
| 48 | include 'includecom' | |
| 49 | ||
| 50 | integer itime,indexf,iter,indz1,indz2,i,lkindz,ngrid | |
| 51 | real xt,yt,zt,uint,vint,psint,thetaconst,phelp,pp,xtn,ytn | |
| 52 | real weight,uhelp,vhelp,qhelp,ph1,ph2,eta | |
| 53 | logical init,firststep | |
| 54 | ||
| 55 | indz1=0 | |
| 56 | indz2=0 | |
| 57 | ||
| 58 | C Determine nested grid coordinates | |
| 59 | *********************************** | |
| 60 | ||
| 61 | if (ngrid.gt.0) then | |
| 62 | xtn=(xt-xln(ngrid))*xresoln(ngrid) | |
| 63 | ytn=(yt-yln(ngrid))*yresoln(ngrid) | |
| 64 | endif | |
| 65 | ||
| 66 | C Calculate the surface pressure. | |
| 67 | ********************************* | |
| 68 | ||
| 69 | if (ngrid.gt.0) then ! nested grid | |
| 70 | call levlininterpoln(psn,maxnests,nxmaxn,nymaxn,1,ngrid,nxn,nyn, | |
| 71 | + memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1),itime, | |
| 72 | + indexf,psint) | |
| 73 | else ! mother grid | |
| 74 | call levlininterpol(ps,nxmax,nymax,1,nx,ny,memind,xt,yt, | |
| 75 | + 1,memtime(indexf),memtime(indexf+1),itime,indexf,psint) | |
| 76 | endif | |
| 77 | ||
| 78 | ||
| 79 | ****************************************************************************** | |
| 80 | C For a new trajectory and the first iteration of petterssen: | |
| 81 | C thetaconst is given in [m] | |
| 82 | C 1. Transformation from height in [m] coordinate to height in eta coordinate. | |
| 83 | C Or: Transformation from hPa to eta. | |
| 84 | C 2. Transformation from height in eta to height in theta [K] coordinate. | |
| 85 | ****************************************************************************** | |
| 86 | ||
| 87 | if (init.and.firststep) then | |
| 88 | if ((lkindz.eq.1).or.(lkindz.eq.2)) then | |
| 89 | if (ngrid.gt.0) then ! nested grid | |
| 90 | call etatrafo(xtn,ytn,thetaconst,memtime(indexf), | |
| 91 | + memtime(indexf+1),itime,indexf,ngrid,psint) | |
| 92 | else ! mother grid | |
| 93 | call etatrafo(xt,yt,thetaconst,memtime(indexf), | |
| 94 | + memtime(indexf+1),itime,indexf,ngrid,psint) | |
| 95 | endif | |
| 96 | zt=thetaconst ! now thetaconst is given in eta | |
| 97 | else if (lkindz.eq.3) then | |
| 98 | zt=eta(psint,zt) | |
| 99 | endif | |
| 100 | ||
| 101 | C Calculate pressure and potential temperature for current position | |
| 102 | ******************************************************************* | |
| 103 | ||
| 104 | phelp=pp(psint,zt) | |
| 105 | if (ngrid.gt.0) then ! nested grid | |
| 106 | call lininterpoln(thn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 107 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 108 | + memtime(indexf+1),itime,indexf,thetaconst) | |
| 109 | else ! mother grid | |
| 110 | call lininterpol(th,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 111 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 112 | + indexf,thetaconst) | |
| 113 | endif | |
| 114 | else | |
| 115 | ||
| 116 | ******************************************************************************** | |
| 117 | C For all other time steps: | |
| 118 | C Transformation from height in theta [K] coordinate to height in eta coordinate | |
| 119 | ******************************************************************************** | |
| 120 | ||
| 121 | if (ngrid.gt.0) then ! nested grid | |
| 122 | call geteta(xtn,ytn,zt,thetaconst,memtime(indexf), | |
| 123 | + memtime(indexf+1),itime,indexf,psint,ngrid,indz1,indz2) | |
| 124 | else ! mother grid | |
| 125 | call geteta(xt,yt,zt,thetaconst,memtime(indexf), | |
| 126 | + memtime(indexf+1),itime,indexf,psint,ngrid,indz1,indz2) | |
| 127 | endif | |
| 128 | endif | |
| 129 | ||
| 130 | ||
| 131 | C Interpolation of wind field data is done. | |
| 132 | ***************************************************************************** | |
| 133 | ||
| 134 | if (indz1.eq.indz2) then ! stable level | |
| 135 | if (ngrid.eq.0) then ! mother grid | |
| 136 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 137 | call interpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 138 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,uint) | |
| 139 | call interpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 140 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,vint) | |
| 141 | else ! bilinear interpolation | |
| 142 | call lininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 143 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 144 | + indexf,uint) | |
| 145 | call lininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 146 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 147 | + indexf,vint) | |
| 148 | endif | |
| 149 | ||
| 150 | else if (ngrid.gt.0) then ! nested grid | |
| 151 | ||
| 152 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 153 | call interpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 154 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 155 | + memtime(indexf+1),itime,indexf,uint) | |
| 156 | call interpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 157 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 158 | + memtime(indexf+1),itime,indexf,vint) | |
| 159 | else ! bilinear interpolation | |
| 160 | call lininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 161 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 162 | + memtime(indexf+1),itime,indexf,uint) | |
| 163 | call lininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 164 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 165 | + memtime(indexf+1),itime,indexf,vint) | |
| 166 | endif | |
| 167 | ||
| 168 | else ! polar stereographic grid | |
| 169 | ! only linear interpolation used | |
| 170 | call lininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 171 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 172 | + indexf,uint) | |
| 173 | call lininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 174 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 175 | + indexf,vint) | |
| 176 | endif | |
| 177 | ||
| 178 | else ! unstable layer | |
| 179 | ||
| 180 | C -> take the layer averaged wind velocity (weighted with pressure increments) | |
| 181 | ****************************************************************************** | |
| 182 | ||
| 183 | weight=0. | |
| 184 | uhelp=0. | |
| 185 | vhelp=0. | |
| 186 | qhelp=0. | |
| 187 | ph1=akz(indz1)+bkz(indz1)*psint | |
| 188 | ||
| 189 | do 10 i=indz1,indz2-1 | |
| 190 | if (ngrid.ge.0) then ! mother grid | |
| 191 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 192 | call levinterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 193 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 194 | + uint) | |
| 195 | call levinterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 196 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 197 | + vint) | |
| 198 | else ! bilinear interpolation | |
| 199 | call levlininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 200 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 201 | + uint) | |
| 202 | call levlininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 203 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 204 | + vint) | |
| 205 | endif | |
| 206 | ||
| 207 | else if (ngrid.gt.0) then ! nested grid | |
| 208 | ||
| 209 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 210 | call levinterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 211 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 212 | + itime,indexf,uint) | |
| 213 | call levinterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 214 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 215 | + itime,indexf,vint) | |
| 216 | else ! linear interpolation | |
| 217 | call levlininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 218 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 219 | + itime,indexf,uint) | |
| 220 | call levlininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 221 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 222 | + itime,indexf,vint) | |
| 223 | endif | |
| 224 | ||
| 225 | else ! polar stereographic grid | |
| 226 | ! only linear interpolation used | |
| 227 | call levlininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 228 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 229 | + uint) | |
| 230 | call levlininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 231 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 232 | + vint) | |
| 233 | endif | |
| 234 | ph2=akm(i+1)+bkm(i+1)*psint | |
| 235 | weight=weight+ph1-ph2 | |
| 236 | uhelp=uhelp+uint*(ph1-ph2) | |
| 237 | vhelp=vhelp+vint*(ph1-ph2) | |
| 238 | 10 ph1=ph2 | |
| 239 | ||
| 240 | if (ngrid.ge.0) then ! mother grid | |
| 241 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 242 | call levinterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 243 | + xt,yt,indz2,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 244 | + uint) | |
| 245 | call levinterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 246 | + xt,yt,indz2,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 247 | + vint) | |
| 248 | else ! bilinear interpolation | |
| 249 | call levlininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 250 | + xt,yt,indz2,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 251 | + uint) | |
| 252 | call levlininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 253 | + xt,yt,indz2,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 254 | + vint) | |
| 255 | endif | |
| 256 | ||
| 257 | else if (ngrid.gt.0) then ! nested grid | |
| 258 | ||
| 259 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 260 | call levinterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 261 | + nxn,nyn,memind,xtn,ytn,indz2,memtime(indexf), | |
| 262 | + memtime(indexf+1),itime,indexf,uint) | |
| 263 | call levinterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 264 | + nxn,nyn,memind,xtn,ytn,indz2,memtime(indexf), | |
| 265 | + memtime(indexf+1),itime,indexf,vint) | |
| 266 | else ! linear interpolation | |
| 267 | call levlininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 268 | + nxn,nyn,memind,xtn,ytn,indz2,memtime(indexf), | |
| 269 | + memtime(indexf+1),itime,indexf,uint) | |
| 270 | call levlininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 271 | + nxn,nyn,memind,xtn,ytn,indz2,memtime(indexf), | |
| 272 | + memtime(indexf+1),itime,indexf,vint) | |
| 273 | endif | |
| 274 | ||
| 275 | else ! polar stereographic grid | |
| 276 | call levlininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 277 | + xt,yt,indz2,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 278 | + uint) | |
| 279 | call levlininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 280 | + xt,yt,indz2,memtime(indexf),memtime(indexf+1),itime,indexf, | |
| 281 | + vint) | |
| 282 | endif | |
| 283 | ||
| 284 | ph2=akz(indz2)+bkz(indz2)*psint | |
| 285 | weight=weight+ph1-ph2 | |
| 286 | uhelp=uhelp+uint*(ph1-ph2) | |
| 287 | vhelp=vhelp+vint*(ph1-ph2) | |
| 288 | ||
| 289 | uint=uhelp/weight | |
| 290 | vint=vhelp/weight | |
| 291 | endif | |
| 292 | ||
| 293 | ||
| 294 | return | |
| 295 | end |
| 0 | subroutine interisobar(xt,yt,zt,pconst,indexf,itime,init, | |
| 1 | +firststep,iter,lkindz,ngrid,uint,vint) | |
| 2 | C i i i/o i i i i | |
| 3 | C i i i i o o | |
| 4 | ******************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation routine for isobaric trajectories. * | |
| 7 | * * | |
| 8 | * Author: A. Stohl * | |
| 9 | * * | |
| 10 | * 27 April 1994 * | |
| 11 | * * | |
| 12 | * Update: 23 December 1998 (Use of global domain and nesting) * | |
| 13 | * * | |
| 14 | ******************************************************************************** | |
| 15 | * * | |
| 16 | * Variables: * | |
| 17 | * eta eta coordinate of pressure level * | |
| 18 | * firststep .true. for first iteration of petterssen * | |
| 19 | * idiff [s] Temporal distance between the windfields used for interpol* | |
| 20 | * init .true. for first time step of trajectory * | |
| 21 | * iter number of iteration step * | |
| 22 | * itime [s] current temporal position * | |
| 23 | * lkindz unit of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 24 | * memtime(3) [s] times of the wind fields in memory * | |
| 25 | * ngrid index which grid is to be used * | |
| 26 | ||
| 27 | * nstop =greater 0, if trajectory calculation is finished * | |
| 28 | * pconst [Pa] pressure level, for which trajectories shall be calculated* | |
| 29 | * uint,vint [m/s] interpolated wind components * | |
| 30 | * xt,yt,zt coordinates position for which wind data shall be calculat* | |
| 31 | * * | |
| 32 | ******************************************************************************** | |
| 33 | ||
| 34 | include 'includepar' | |
| 35 | include 'includecom' | |
| 36 | ||
| 37 | integer itime,indexf,iter,lkindz,ngrid | |
| 38 | real xt,yt,zt,uint,vint,psint,eta,pconst,pp,xtn,ytn | |
| 39 | logical init,firststep | |
| 40 | ||
| 41 | ||
| 42 | C Determine nested grid coordinates | |
| 43 | *********************************** | |
| 44 | ||
| 45 | if (ngrid.gt.0) then | |
| 46 | xtn=(xt-xln(ngrid))*xresoln(ngrid) | |
| 47 | ytn=(yt-yln(ngrid))*yresoln(ngrid) | |
| 48 | endif | |
| 49 | ||
| 50 | ||
| 51 | C For a new trajectory and the first iteration of petterssen: | |
| 52 | C Transformation from height in [m] coordinate to height in eta coordinate. | |
| 53 | C Or: Transformation from hPa to eta. | |
| 54 | C For this it is necessary to know the surface pressure. | |
| 55 | *************************************************************************** | |
| 56 | ||
| 57 | if (init.and.firststep) then | |
| 58 | C Calculate the surface pressure. | |
| 59 | ********************************* | |
| 60 | ||
| 61 | if (ngrid.gt.0) then ! nested grid | |
| 62 | call levlininterpoln(psn,maxnests,nxmaxn,nymaxn,1,ngrid, | |
| 63 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 64 | + itime,indexf,psint) | |
| 65 | else ! mother grid | |
| 66 | call levlininterpol(ps,nxmax,nymax,1,nx,ny,memind,xt,yt, | |
| 67 | + 1,memtime(indexf),memtime(indexf+1),itime,indexf,psint) | |
| 68 | endif | |
| 69 | ||
| 70 | if ((lkindz.eq.1).or.(lkindz.eq.2)) then | |
| 71 | if (ngrid.gt.0) then ! nested grid | |
| 72 | call etatrafo(xtn,ytn,zt,memtime(indexf),memtime(indexf+1), | |
| 73 | + itime,indexf,ngrid,psint) | |
| 74 | else ! mother grid | |
| 75 | call etatrafo(xt,yt,zt,memtime(indexf),memtime(indexf+1), | |
| 76 | + itime,indexf,ngrid,psint) | |
| 77 | endif | |
| 78 | pconst=pp(psint,zt) | |
| 79 | else if (lkindz.eq.3) then | |
| 80 | zt=eta(psint,zt) | |
| 81 | endif | |
| 82 | endif | |
| 83 | ||
| 84 | ||
| 85 | C Transformation from height in pressure coordinate to height in eta coordinate. | |
| 86 | C For this it is necessary to know the surface pressure. | |
| 87 | ********************************************************************************* | |
| 88 | ||
| 89 | if (ngrid.gt.0) then | |
| 90 | call levlininterpoln(psn,maxnests,nxmaxn,nymaxn,1,ngrid, | |
| 91 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 92 | + itime,indexf,psint) | |
| 93 | else | |
| 94 | call levlininterpol(ps,nxmax,nymax,1,nx,ny,memind,xt,yt, | |
| 95 | + 1,memtime(indexf),memtime(indexf+1),itime,indexf,psint) | |
| 96 | endif | |
| 97 | zt=eta(psint,pconst) | |
| 98 | ||
| 99 | ||
| 100 | C Interpolation of wind field data is done. | |
| 101 | ***************************************************************************** | |
| 102 | ||
| 103 | if (ngrid.eq.0) then ! mother grid | |
| 104 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 105 | call interpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 106 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,uint) | |
| 107 | call interpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 108 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,vint) | |
| 109 | else ! bilinear interpolation | |
| 110 | call lininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 111 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 112 | + indexf,uint) | |
| 113 | call lininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 114 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 115 | + indexf,vint) | |
| 116 | endif | |
| 117 | ||
| 118 | else if (ngrid.gt.0) then ! nested grid | |
| 119 | ||
| 120 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 121 | call interpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 122 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 123 | + memtime(indexf+1),itime,indexf,uint) | |
| 124 | call interpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 125 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 126 | + memtime(indexf+1),itime,indexf,vint) | |
| 127 | else ! bilinear interpolation | |
| 128 | call lininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 129 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 130 | + memtime(indexf+1),itime,indexf,uint) | |
| 131 | call lininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 132 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 133 | + memtime(indexf+1),itime,indexf,vint) | |
| 134 | endif | |
| 135 | ||
| 136 | else ! polar stereographic grid | |
| 137 | ||
| 138 | call lininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 139 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 140 | + indexf,uint) | |
| 141 | call lininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 142 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 143 | + indexf,vint) | |
| 144 | endif | |
| 145 | ||
| 146 | return | |
| 147 | end |
| 0 | subroutine intermix(xt,yt,zt,zconst,indexf,itime,iter,ngrid, | |
| 1 | +uint,vint) | |
| 2 | C i i i i i i i i | |
| 3 | C o o | |
| 4 | ******************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation routine for mixing layer trajectories. * | |
| 7 | * * | |
| 8 | * Author: A. Stohl * | |
| 9 | * * | |
| 10 | * 27 April 1994 * | |
| 11 | * * | |
| 12 | * Update: 23 December 1998 (Use of global domain and nesting) * | |
| 13 | * * | |
| 14 | ******************************************************************************** | |
| 15 | * * | |
| 16 | * Variables: * | |
| 17 | * firstep .true. for first iteration of petterssen * | |
| 18 | * hmix height of mixing layer in eta coordinates * | |
| 19 | * idiff [s] Temporal distance between the windfields used for interpol* | |
| 20 | * induvz index of the model layer beneath current position of traj.* | |
| 21 | * init .true. for first time step of trajectory * | |
| 22 | * iter number of iteration step * | |
| 23 | * itime [s] current temporal position * | |
| 24 | * memtime(3) [s] times of the wind fields in memory * | |
| 25 | * pp [Pa] pressure at mixing height * | |
| 26 | * ngrid index which grid is to be used * | |
| 27 | ||
| 28 | * nstop =greater 0, if trajectory calculation is finished * | |
| 29 | * uint,vint [m/s] interpolated wind components * | |
| 30 | * xt,yt,zt coordinates position for which wind data shall be calculat* | |
| 31 | * zconst [m] height of mixing layer * | |
| 32 | * * | |
| 33 | ******************************************************************************** | |
| 34 | ||
| 35 | include 'includepar' | |
| 36 | include 'includecom' | |
| 37 | ||
| 38 | integer i,itime,indexf,induvz,iter,ngrid | |
| 39 | real xt,yt,zt,zconst,uint,vint,uhelp,vhelp,qhelp | |
| 40 | real psint,xtn,ytn,hmix,weight,pp,ph1,ph2 | |
| 41 | ||
| 42 | ||
| 43 | C Determine nested grid coordinates | |
| 44 | *********************************** | |
| 45 | ||
| 46 | if (ngrid.gt.0) then | |
| 47 | xtn=(xt-xln(ngrid))*xresoln(ngrid) | |
| 48 | ytn=(yt-yln(ngrid))*yresoln(ngrid) | |
| 49 | endif | |
| 50 | ||
| 51 | ||
| 52 | C Transformation from mixing height in [m] coordinate to height in eta coordinate. | |
| 53 | C For this it is necessary to know the surface pressure. | |
| 54 | ********************************************************************************** | |
| 55 | ||
| 56 | if (ngrid.gt.0) then ! nested grid | |
| 57 | call levlininterpoln(psn,maxnests,nxmaxn,nymaxn,1,ngrid, | |
| 58 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 59 | + itime,indexf,psint) | |
| 60 | hmix=zconst | |
| 61 | call etatrafo(xtn,ytn,hmix,memtime(indexf),memtime(indexf+1), | |
| 62 | + itime,indexf,ngrid,psint) | |
| 63 | else ! mother grid | |
| 64 | call levlininterpol(ps,nxmax,nymax,1,nx,ny,memind, | |
| 65 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime,indexf,psint) | |
| 66 | hmix=zconst | |
| 67 | call etatrafo(xt,yt,hmix,memtime(indexf),memtime(indexf+1), | |
| 68 | + itime,indexf,ngrid,psint) | |
| 69 | endif | |
| 70 | ||
| 71 | ||
| 72 | C Calculate the index of layers between which the mixed layer height is situated. | |
| 73 | ********************************************************************************* | |
| 74 | ||
| 75 | do 85 induvz=1,nuvz-1 | |
| 76 | if (uvheight(induvz).ge.hmix) goto 86 | |
| 77 | 85 continue | |
| 78 | 86 continue | |
| 79 | ||
| 80 | C Mixed layer height is located between uvheight(induvz-1) and uvheight(induvz) | |
| 81 | ******************************************************************************* | |
| 82 | ||
| 83 | C 1.) If mixed layer height is lower than the first model level | |
| 84 | C -> take wind data from first model level | |
| 85 | *************************************************************** | |
| 86 | ||
| 87 | if (induvz.eq.1) then | |
| 88 | zt=uvheight(1) | |
| 89 | if (ngrid.eq.0) then ! mother grid | |
| 90 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 91 | call levinterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 92 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime, | |
| 93 | + indexf,uint) | |
| 94 | call levinterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 95 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime, | |
| 96 | + indexf,vint) | |
| 97 | else ! linear interpolation | |
| 98 | call levlininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 99 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime, | |
| 100 | + indexf,uint) | |
| 101 | call levlininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 102 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime, | |
| 103 | + indexf,vint) | |
| 104 | endif | |
| 105 | ||
| 106 | else if (ngrid.gt.0) then ! nested grid | |
| 107 | ||
| 108 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 109 | call levinterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 110 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 111 | + itime,indexf,uint) | |
| 112 | call levinterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 113 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 114 | + itime,indexf,vint) | |
| 115 | else ! linear interpolation | |
| 116 | call levlininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 117 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 118 | + itime,indexf,uint) | |
| 119 | call levlininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 120 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 121 | + itime,indexf,vint) | |
| 122 | endif | |
| 123 | ||
| 124 | else ! polar stereographic grid | |
| 125 | ! only linear interpolation used | |
| 126 | call levlininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 127 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime, | |
| 128 | + indexf,uint) | |
| 129 | call levlininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 130 | + xt,yt,1,memtime(indexf),memtime(indexf+1),itime, | |
| 131 | + indexf,vint) | |
| 132 | endif | |
| 133 | ||
| 134 | ||
| 135 | C 2.) Normal case: mixed layer higher than the first model level | |
| 136 | C -> take average wind within mixed layer for trajectory displacement | |
| 137 | ************************************************************************* | |
| 138 | ||
| 139 | else | |
| 140 | weight=0. | |
| 141 | uhelp=0. | |
| 142 | vhelp=0. | |
| 143 | qhelp=0. | |
| 144 | ph1=psint | |
| 145 | ||
| 146 | do 140 i=1,induvz-2 | |
| 147 | ||
| 148 | C Interpolation of wind field data is done. | |
| 149 | C -> Interpolated winds are weighted with the thicknesses of the layers | |
| 150 | *********************************************************************** | |
| 151 | ||
| 152 | if (ngrid.eq.0) then ! mother grid | |
| 153 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 154 | call levinterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 155 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime, | |
| 156 | + indexf,uint) | |
| 157 | call levinterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 158 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime, | |
| 159 | + indexf,vint) | |
| 160 | else ! bilinear interpolation | |
| 161 | call levlininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 162 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime, | |
| 163 | + indexf,uint) | |
| 164 | call levlininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 165 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime, | |
| 166 | + indexf,vint) | |
| 167 | endif | |
| 168 | ||
| 169 | else if (ngrid.gt.0) then ! nested grid | |
| 170 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 171 | call levinterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 172 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 173 | + itime,indexf,uint) | |
| 174 | call levinterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 175 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 176 | + itime,indexf,vint) | |
| 177 | else ! linear interpolation | |
| 178 | call levlininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 179 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 180 | + itime,indexf,uint) | |
| 181 | call levlininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 182 | + nxn,nyn,memind,xtn,ytn,i,memtime(indexf),memtime(indexf+1), | |
| 183 | + itime,indexf,vint) | |
| 184 | endif | |
| 185 | ||
| 186 | else ! polar stereographic grid | |
| 187 | ! only linear interpolation used | |
| 188 | call levlininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 189 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime, | |
| 190 | + indexf,uint) | |
| 191 | call levlininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 192 | + xt,yt,i,memtime(indexf),memtime(indexf+1),itime, | |
| 193 | + indexf,vint) | |
| 194 | endif | |
| 195 | ph2=akm(i+1)+bkm(i+1)*psint | |
| 196 | weight=weight+ph1-ph2 | |
| 197 | uhelp=uhelp+uint*(ph1-ph2) | |
| 198 | vhelp=vhelp+vint*(ph1-ph2) | |
| 199 | 140 ph1=ph2 | |
| 200 | ||
| 201 | ||
| 202 | if (ngrid.eq.0) then ! mother grid | |
| 203 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 204 | call levinterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 205 | + xt,yt,induvz-1,memtime(indexf),memtime(indexf+1),itime, | |
| 206 | + indexf,uint) | |
| 207 | call levinterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 208 | + xt,yt,induvz-1,memtime(indexf),memtime(indexf+1),itime, | |
| 209 | + indexf,vint) | |
| 210 | else ! bilinear interpolation | |
| 211 | call levlininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 212 | + xt,yt,induvz-1,memtime(indexf),memtime(indexf+1),itime, | |
| 213 | + indexf,uint) | |
| 214 | call levlininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 215 | + xt,yt,induvz-1,memtime(indexf),memtime(indexf+1),itime, | |
| 216 | + indexf,vint) | |
| 217 | endif | |
| 218 | ||
| 219 | else if (ngrid.gt.0) then ! nested grid | |
| 220 | ||
| 221 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 222 | call levinterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 223 | + nxn,nyn,memind,xtn,ytn,induvz-1,memtime(indexf), | |
| 224 | + memtime(indexf+1),itime,indexf,uint) | |
| 225 | call levinterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 226 | + nxn,nyn,memind,xtn,ytn,induvz-1,memtime(indexf), | |
| 227 | + memtime(indexf+1),itime,indexf,vint) | |
| 228 | else ! linear interpolation | |
| 229 | call levlininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 230 | + ngrid,nxn,nyn,memind,xtn,ytn,induvz-1,memtime(indexf), | |
| 231 | + memtime(indexf+1),itime,indexf,uint) | |
| 232 | call levlininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 233 | + ngrid,nxn,nyn,memind,xtn,ytn,induvz-1,memtime(indexf), | |
| 234 | + memtime(indexf+1),itime,indexf,vint) | |
| 235 | endif | |
| 236 | ||
| 237 | else ! polar stereographic grid | |
| 238 | ! only linear interpolation used | |
| 239 | call levlininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 240 | + xt,yt,induvz-1,memtime(indexf),memtime(indexf+1),itime, | |
| 241 | + indexf,uint) | |
| 242 | call levlininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 243 | + xt,yt,induvz-1,memtime(indexf),memtime(indexf+1),itime, | |
| 244 | + indexf,vint) | |
| 245 | endif | |
| 246 | ph2=pp(psint,hmix) | |
| 247 | weight=weight+ph1-ph2 | |
| 248 | uhelp=uhelp+uint*(ph1-ph2) | |
| 249 | vhelp=vhelp+vint*(ph1-ph2) | |
| 250 | ||
| 251 | uint=uhelp/weight | |
| 252 | vint=vhelp/weight | |
| 253 | endif | |
| 254 | zt=hmix | |
| 255 | ||
| 256 | return | |
| 257 | end |
| 0 | subroutine intermod(xt,yt,zt,indexf,itime,init,firststep, | |
| 1 | +iter,lkindz,ngrid,uint,vint) | |
| 2 | C i i i i i i i | |
| 3 | C i i i o o | |
| 4 | ******************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation routine for trajectories on model layers. * | |
| 7 | * * | |
| 8 | * Author: A. Stohl * | |
| 9 | * * | |
| 10 | * 27 April 1994 * | |
| 11 | * * | |
| 12 | * Update: 23 December 1998 (Use of global domain and nesting) * | |
| 13 | * * | |
| 14 | ******************************************************************************** | |
| 15 | * * | |
| 16 | * Variables: * | |
| 17 | * firstep .true. for first iteration of petterssen * | |
| 18 | * idiff [s] Temporal distance between the windfields used for interpol* | |
| 19 | * init .true. for first time step of trajectory * | |
| 20 | * iter number of iteration step * | |
| 21 | * itime [s] current temporal position * | |
| 22 | * lkindz unit of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 23 | * memtime(3) [s] times of the wind fields in memory * | |
| 24 | * ngrid index which grid is to be used * | |
| 25 | * nstop =greater 0, if trajectory calculation is finished * | |
| 26 | * uint,vint [m/s] interpolated wind components * | |
| 27 | * xt,yt,zt coordinates position for which wind data shall be calculat* | |
| 28 | * * | |
| 29 | ******************************************************************************** | |
| 30 | ||
| 31 | include 'includepar' | |
| 32 | include 'includecom' | |
| 33 | ||
| 34 | integer itime,indexf,iter,lkindz,ngrid | |
| 35 | real xt,yt,zt,uint,vint,psint,eta,xtn,ytn | |
| 36 | logical firststep,init | |
| 37 | ||
| 38 | ||
| 39 | C Determine nested grid coordinates | |
| 40 | *********************************** | |
| 41 | ||
| 42 | if (ngrid.gt.0) then | |
| 43 | xtn=(xt-xln(ngrid))*xresoln(ngrid) | |
| 44 | ytn=(yt-yln(ngrid))*yresoln(ngrid) | |
| 45 | endif | |
| 46 | ||
| 47 | ||
| 48 | C For a new trajectory and the first iteration of petterssen: | |
| 49 | C Transformation from height in [m] coordinate to height in eta coordinate. | |
| 50 | C Or: Transformation from hPa to eta. | |
| 51 | *************************************************************************** | |
| 52 | ||
| 53 | if (init.and.firststep) then | |
| 54 | C Calculate the surface pressure. | |
| 55 | ********************************* | |
| 56 | ||
| 57 | if (ngrid.gt.0) then ! nested grid | |
| 58 | call levlininterpoln(psn,maxnests,nxmaxn,nymaxn,1,ngrid, | |
| 59 | + nxn,nyn,memind,xtn,ytn,1,memtime(indexf),memtime(indexf+1), | |
| 60 | + itime,indexf,psint) | |
| 61 | else ! mother grid | |
| 62 | call levlininterpol(ps,nxmax,nymax,1,nx,ny,memind,xt,yt, | |
| 63 | + 1,memtime(indexf),memtime(indexf+1),itime,indexf,psint) | |
| 64 | endif | |
| 65 | ||
| 66 | if ((lkindz.eq.1).or.(lkindz.eq.2)) then | |
| 67 | if (ngrid.gt.0) then ! nested grid | |
| 68 | call etatrafo(xtn,ytn,zt,memtime(indexf),memtime(indexf+1), | |
| 69 | + itime,indexf,ngrid,psint) | |
| 70 | else ! mother grid | |
| 71 | call etatrafo(xt,yt,zt,memtime(indexf),memtime(indexf+1), | |
| 72 | + itime,indexf,ngrid,psint) | |
| 73 | endif | |
| 74 | else if (lkindz.eq.3) then | |
| 75 | zt=eta(psint,zt) | |
| 76 | endif | |
| 77 | endif | |
| 78 | ||
| 79 | ||
| 80 | ||
| 81 | C Interpolation of wind field data is done. | |
| 82 | C Either linear interpolation (if selected and for first iteration | |
| 83 | C of petterssen) or bicubic interpolation | |
| 84 | **************************************************************************** | |
| 85 | ||
| 86 | if (ngrid.eq.0) then ! mother grid | |
| 87 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 88 | call interpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 89 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,uint) | |
| 90 | call interpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind,uvheight, | |
| 91 | + xt,yt,zt,memtime(indexf),memtime(indexf+1),itime,indexf,vint) | |
| 92 | else ! bilinear interpolation | |
| 93 | call lininterpol(uu,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 94 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 95 | + indexf,uint) | |
| 96 | call lininterpol(vv,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 97 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 98 | + indexf,vint) | |
| 99 | endif | |
| 100 | ||
| 101 | else if (ngrid.gt.0) then ! nested grid | |
| 102 | ||
| 103 | if ((inpolkind.eq.1).and.(iter.ne.1)) then | |
| 104 | call interpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 105 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 106 | + memtime(indexf+1),itime,indexf,uint) | |
| 107 | call interpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 108 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 109 | + memtime(indexf+1),itime,indexf,vint) | |
| 110 | else ! bilinear interpolation | |
| 111 | call lininterpoln(uun,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 112 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 113 | + memtime(indexf+1),itime,indexf,uint) | |
| 114 | call lininterpoln(vvn,maxnests,nxmaxn,nymaxn,nuvzmax, | |
| 115 | + ngrid,nxn,nyn,nuvz,memind,uvheight,xtn,ytn,zt,memtime(indexf), | |
| 116 | + memtime(indexf+1),itime,indexf,vint) | |
| 117 | endif | |
| 118 | ||
| 119 | else ! polar stereographic grid | |
| 120 | ! only linear interpolation used | |
| 121 | call lininterpol(uupol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 122 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 123 | + indexf,uint) | |
| 124 | call lininterpol(vvpol,nxmax,nymax,nuvzmax,nx,ny,nuvz,memind, | |
| 125 | + uvheight,xt,yt,zt,memtime(indexf),memtime(indexf+1),itime, | |
| 126 | + indexf,vint) | |
| 127 | endif | |
| 128 | ||
| 129 | return | |
| 130 | end |
| 0 | subroutine interpol(yy,nxmax,nymax,nzmax,nx,ny,nz,memind,height, | |
| 1 | +xt,yt,zt,itime1,itime2,itime,indexf,yint) | |
| 2 | C i i i i i i i i i | |
| 3 | C i i i i i i i o | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of 3-dimensional meteorological fields. * | |
| 7 | * In horizontal direction bicubic interpolation interpolation is used. * | |
| 8 | * In the vertical a polynomial interpolation is used. * | |
| 9 | * In the temporal direction linear interpolation is used. * | |
| 10 | * These interpolation techniques have been found to be most accurate. * | |
| 11 | * * | |
| 12 | * The interpolation routines have been taken from: * | |
| 13 | * Press W.H. et al. (1992): Numerical Recipes in FORTRAN. The art of * | |
| 14 | * scientific computing. 2nd edition. Cambridge University Press. * | |
| 15 | * * | |
| 16 | * But they have been modified for faster performance. * | |
| 17 | * * | |
| 18 | * 4-3 * | |
| 19 | * | | The points are numbered in this order. Values and gradients are * | |
| 20 | * 1-2 stored in fields with dimension 4. * | |
| 21 | * * | |
| 22 | * 1,2 is the level closest to the current position for the first time * | |
| 23 | * 1,1 is the level below 1,2 * | |
| 24 | * 1,3 is the level above 1,2 * | |
| 25 | * 2,2 is the level closest to the current position for the second time * | |
| 26 | * 2,1 is the level below 2,2 * | |
| 27 | * 2,3 is the level above 2,2 * | |
| 28 | * * | |
| 29 | * * | |
| 30 | * Author: A. Stohl * | |
| 31 | * * | |
| 32 | * 30 May 1994 * | |
| 33 | * * | |
| 34 | ***************************************************************************** | |
| 35 | * * | |
| 36 | * Variables: * | |
| 37 | * * | |
| 38 | * dt1,dt2 time differences between fields and current position * | |
| 39 | * dz1,dz2 z distance between levels and current position * | |
| 40 | * height(nzmax) heights of the model levels * | |
| 41 | * indexf indicates the number of the wind field to be read in * | |
| 42 | * indexfh help variable * | |
| 43 | * indz the level closest to the current trajectory position * | |
| 44 | * indzh help variable * | |
| 45 | * itime current time * | |
| 46 | * itime1 time of the first wind field * | |
| 47 | * itime2 time of the second wind field * | |
| 48 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 49 | * memind(3) points to the places of the wind fields * | |
| 50 | * nx,ny,nz actual field dimensions in x,y and z direction * | |
| 51 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 52 | * x1l,x2l x,y coordinates of lower left subgrid point * | |
| 53 | * x1u,x2u x,y coordinates of upper right subgrid point * | |
| 54 | * xt current x coordinate * | |
| 55 | * y(4,2,3) subset of 4 points for 2 times and 3 levels * | |
| 56 | * ygx(4,2,3) x gradients at 4 points for 2 times and 3 levels * | |
| 57 | * ygy(4,2,3) y gradients at 4 points for 2 times and 3 levels * | |
| 58 | * ygxy(4,2,3) x,y gradients at 4 points for 2 times and 3 levels * | |
| 59 | * yhelp(2,3) the interpolated values for 2 times and 3 levels * | |
| 60 | * yh2(2) the interpolated values for the 2 times * | |
| 61 | * yint the final interpolated value * | |
| 62 | * yt current y coordinate * | |
| 63 | * yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation * | |
| 64 | * zt current z coordinate * | |
| 65 | * * | |
| 66 | ***************************************************************************** | |
| 67 | ||
| 68 | implicit none | |
| 69 | ||
| 70 | integer nx,ny,nz,nxmax,nymax,nzmax,memind(3),i,j,l,m,n,ix,jy | |
| 71 | integer itime,itime1,itime2,indexf,indz,indexfh,indzh,im,ip,jm,jp | |
| 72 | real yy(0:nxmax-1,0:nymax-1,nzmax,3),height(nzmax) | |
| 73 | real y(4,2,3),ygx(4,2,3),ygy(4,2,3),ygxy(4,2,3),yhelp(2,3),yh2(2) | |
| 74 | real x1l,x1u,x2l,x2u,dz1,dz2,dt1,dt2,zz(3) | |
| 75 | real xt,yt,zt,yint | |
| 76 | ||
| 77 | ||
| 78 | C 3 levels are needed for the polynomial interpolation in the vertical | |
| 79 | C Determine the closest vertical level -1 | |
| 80 | ********************************************************************** | |
| 81 | ||
| 82 | do 5 i=1,nz-1 | |
| 83 | if ((height(i).le.zt).and.(height(i+1).ge.zt)) then | |
| 84 | dz1=zt-height(i) | |
| 85 | dz2=height(i+1)-zt | |
| 86 | if (dz1.lt.dz2) then | |
| 87 | indz=i-1 | |
| 88 | else | |
| 89 | indz=i | |
| 90 | endif | |
| 91 | goto 6 | |
| 92 | endif | |
| 93 | 5 continue | |
| 94 | 6 continue | |
| 95 | if (indz.lt.1) indz=1 | |
| 96 | if (indz.gt.(nz-2)) indz=nz-2 | |
| 97 | ||
| 98 | ||
| 99 | C If point at border of grid -> small displacement into grid | |
| 100 | ************************************************************ | |
| 101 | ||
| 102 | if (xt.ge.float(nx-1)) xt=float(nx-1)-0.00001 | |
| 103 | if (yt.ge.float(ny-1)) yt=float(ny-1)-0.00001 | |
| 104 | ||
| 105 | ||
| 106 | ||
| 107 | *********************************************************************** | |
| 108 | C 1.) Bicubic horizontal interpolation | |
| 109 | C This has to be done separately for 6 fields (Temporal(2)*Vertical(3)) | |
| 110 | *********************************************************************** | |
| 111 | ||
| 112 | C Determine the lower left corner | |
| 113 | ********************************* | |
| 114 | ||
| 115 | ix=int(xt) | |
| 116 | jy=int(yt) | |
| 117 | ||
| 118 | x1l=float(ix) | |
| 119 | x1u=float(ix+1) | |
| 120 | x2l=float(jy) | |
| 121 | x2u=float(jy+1) | |
| 122 | ||
| 123 | ||
| 124 | C Loop over the 2*2 grid points | |
| 125 | ******************************* | |
| 126 | ||
| 127 | do 10 l=1,4 | |
| 128 | if (l.eq.1) then | |
| 129 | i=ix | |
| 130 | j=jy | |
| 131 | else if (l.eq.2) then | |
| 132 | i=ix+1 | |
| 133 | j=jy | |
| 134 | else if (l.eq.3) then | |
| 135 | i=ix+1 | |
| 136 | j=jy+1 | |
| 137 | else if (l.eq.4) then | |
| 138 | i=ix | |
| 139 | j=jy+1 | |
| 140 | endif | |
| 141 | ip=i+1 | |
| 142 | im=i-1 | |
| 143 | jp=j+1 | |
| 144 | jm=j-1 | |
| 145 | ||
| 146 | ||
| 147 | C Loop over 2 time steps and 3 levels | |
| 148 | ************************************* | |
| 149 | ||
| 150 | do 10 m=1,2 | |
| 151 | indexfh=memind(indexf+m-1) | |
| 152 | do 10 n=1,3 | |
| 153 | indzh=indz+n-1 | |
| 154 | ||
| 155 | ||
| 156 | C Values at the 2*2 subgrid | |
| 157 | *************************** | |
| 158 | ||
| 159 | y(l,m,n)=yy(i,j,indzh,indexfh) | |
| 160 | ||
| 161 | ||
| 162 | C Calculate derivatives in x-direction on the 2*2 subgrid | |
| 163 | ********************************************************* | |
| 164 | ||
| 165 | if (i.eq.0) then | |
| 166 | ygx(l,m,n) = yy(ip,j ,indzh,indexfh) | |
| 167 | + - yy(i ,j ,indzh,indexfh) | |
| 168 | else if (i.eq.nx-1) then | |
| 169 | ygx(l,m,n) = yy(i ,j ,indzh,indexfh) | |
| 170 | + - yy(im,j ,indzh,indexfh) | |
| 171 | else | |
| 172 | ygx(l,m,n) =(yy(ip,j ,indzh,indexfh) | |
| 173 | + - yy(im,j ,indzh,indexfh))/2. | |
| 174 | endif | |
| 175 | ||
| 176 | ||
| 177 | C Calculate derivatives in y-direction on the 2*2 subgrid | |
| 178 | ********************************************************* | |
| 179 | ||
| 180 | if (j.eq.0) then | |
| 181 | ygy(l,m,n) = yy(i ,jp,indzh,indexfh) | |
| 182 | + - yy(i ,j ,indzh,indexfh) | |
| 183 | else if (j.eq.ny-1) then | |
| 184 | ygy(l,m,n) = yy(i ,j ,indzh,indexfh) | |
| 185 | + - yy(i ,jm,indzh,indexfh) | |
| 186 | else | |
| 187 | ygy(l,m,n) =(yy(i ,jp,indzh,indexfh) | |
| 188 | + - yy(i ,jm,indzh,indexfh))/2. | |
| 189 | endif | |
| 190 | ||
| 191 | ||
| 192 | C Calculate cross derivative on the 2*2 subgrid | |
| 193 | *********************************************** | |
| 194 | ||
| 195 | if ((i.eq.0).and.(j.eq.0)) then | |
| 196 | ygxy(l,m,n)= yy(ip,jp,indzh,indexfh)- | |
| 197 | + yy(ip,j ,indzh,indexfh)- | |
| 198 | + yy(i ,jp,indzh,indexfh)+ | |
| 199 | + yy(i ,j ,indzh,indexfh) | |
| 200 | else if ((i.eq.nx-1).and.(j.eq.ny-1)) then | |
| 201 | ygxy(l,m,n)= yy(i ,j ,indzh,indexfh)- | |
| 202 | + yy(i ,jm,indzh,indexfh)- | |
| 203 | + yy(im,j ,indzh,indexfh)+ | |
| 204 | + yy(im,jm,indzh,indexfh) | |
| 205 | else if ((i.eq.0).and.(j.eq.ny-1)) then | |
| 206 | ygxy(l,m,n)= yy(ip,j ,indzh,indexfh)- | |
| 207 | + yy(ip,jm,indzh,indexfh)- | |
| 208 | + yy(i ,j ,indzh,indexfh)+ | |
| 209 | + yy(i ,jm,indzh,indexfh) | |
| 210 | else if ((i.eq.nx-1).and.(j.eq.0)) then | |
| 211 | ygxy(l,m,n)= yy(i ,jp,indzh,indexfh)- | |
| 212 | + yy(i ,j ,indzh,indexfh)- | |
| 213 | + yy(im,jp,indzh,indexfh)+ | |
| 214 | + yy(im,j ,indzh,indexfh) | |
| 215 | else if (i.eq.nx-1) then | |
| 216 | ygxy(l,m,n)=(yy(i ,jp,indzh,indexfh)- | |
| 217 | + yy(i ,jm,indzh,indexfh)- | |
| 218 | + yy(im,jp,indzh,indexfh)+ | |
| 219 | + yy(im,jm,indzh,indexfh))/2. | |
| 220 | else if (i.eq.0) then | |
| 221 | ygxy(l,m,n)=(yy(ip,jp,indzh,indexfh)- | |
| 222 | + yy(ip,jm,indzh,indexfh)- | |
| 223 | + yy(i ,jp,indzh,indexfh)+ | |
| 224 | + yy(i ,jm,indzh,indexfh))/2. | |
| 225 | else if (j.eq.ny-1) then | |
| 226 | ygxy(l,m,n)=(yy(ip,j ,indzh,indexfh)- | |
| 227 | + yy(ip,jm,indzh,indexfh)- | |
| 228 | + yy(im,j ,indzh,indexfh)+ | |
| 229 | + yy(im,jm,indzh,indexfh))/2. | |
| 230 | else if (j.eq.0) then | |
| 231 | ygxy(l,m,n)=(yy(ip,jp,indzh,indexfh)- | |
| 232 | + yy(ip,j ,indzh,indexfh)- | |
| 233 | + yy(im,jp,indzh,indexfh)+ | |
| 234 | + yy(im,j ,indzh,indexfh))/2. | |
| 235 | else | |
| 236 | ygxy(l,m,n)=(yy(ip,jp,indzh,indexfh)- | |
| 237 | + yy(ip,jm,indzh,indexfh)- | |
| 238 | + yy(im,jp,indzh,indexfh)+ | |
| 239 | + yy(im,jm,indzh,indexfh))/4. | |
| 240 | endif | |
| 241 | ||
| 242 | 10 continue | |
| 243 | ||
| 244 | ||
| 245 | C Call bicubic interpolation | |
| 246 | **************************** | |
| 247 | ||
| 248 | call bicubic(y,ygx,ygy,ygxy,x1l,x1u,x2l,x2u,xt,yt,yhelp,2,3) | |
| 249 | ||
| 250 | ||
| 251 | ||
| 252 | ************************************************** | |
| 253 | C 2. Vertical interpolation by a 2nd order polynom | |
| 254 | ************************************************** | |
| 255 | ||
| 256 | do 20 n=1,3 | |
| 257 | 20 zz(n)=height(indz+n-1) | |
| 258 | ||
| 259 | call polynom(zz,yhelp,3,zt,yh2,2) | |
| 260 | ||
| 261 | ||
| 262 | ||
| 263 | ************************************* | |
| 264 | C 3.) Temporal interpolation (linear) | |
| 265 | ************************************* | |
| 266 | ||
| 267 | dt1=float(itime-itime1) | |
| 268 | dt2=float(itime2-itime) | |
| 269 | ||
| 270 | yint=(yh2(1)*dt2+yh2(2)*dt1)/(dt1+dt2) | |
| 271 | ||
| 272 | ||
| 273 | return | |
| 274 | end |
| 0 | subroutine interpoln(yy,maxnests,nxmax,nymax,nzmax,ngrid, | |
| 1 | +nxn,nyn,nz,memind,height,xt,yt,zt,itime1,itime2,itime,indexf,yint) | |
| 2 | C i i i i i i | |
| 3 | C i i i i i i i i i i i i i | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of nested 3-dimensional meteorological fields. * | |
| 7 | * In horizontal direction bicubic interpolation interpolation is used. * | |
| 8 | * In the vertical a polynomial interpolation is used. * | |
| 9 | * In the temporal direction linear interpolation is used. * | |
| 10 | * These interpolation techniques have been found to be most accurate. * | |
| 11 | * * | |
| 12 | * The interpolation routines have been taken from: * | |
| 13 | * Press W.H. et al. (1992): Numerical Recipes in FORTRAN. The art of * | |
| 14 | * scientific computing. 2nd edition. Cambridge University Press. * | |
| 15 | * * | |
| 16 | * But they have been modified for faster performance. * | |
| 17 | * * | |
| 18 | * 4-3 * | |
| 19 | * | | The points are numbered in this order. Values and gradients are * | |
| 20 | * 1-2 stored in fields with dimension 4. * | |
| 21 | * * | |
| 22 | * 1,2 is the level closest to the current position for the first time * | |
| 23 | * 1,1 is the level below 1,2 * | |
| 24 | * 1,3 is the level above 1,2 * | |
| 25 | * 2,2 is the level closest to the current position for the second time * | |
| 26 | * 2,1 is the level below 2,2 * | |
| 27 | * 2,3 is the level above 2,2 * | |
| 28 | * * | |
| 29 | * * | |
| 30 | * Author: A. Stohl * | |
| 31 | * * | |
| 32 | * 30 May 1994 * | |
| 33 | * * | |
| 34 | ***************************************************************************** | |
| 35 | * * | |
| 36 | * Variables: * | |
| 37 | * * | |
| 38 | * dt1,dt2 time differences between fields and current position * | |
| 39 | * dz1,dz2 z distance between levels and current position * | |
| 40 | * height(nzmax) heights of the model levels * | |
| 41 | * indexf indicates the number of the wind field to be read in * | |
| 42 | * indexfh help variable * | |
| 43 | * indz the level closest to the current trajectory position * | |
| 44 | * indzh help variable * | |
| 45 | * itime current time * | |
| 46 | * itime1 time of the first wind field * | |
| 47 | * itime2 time of the second wind field * | |
| 48 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 49 | * memind(3) points to the places of the wind fields * | |
| 50 | * nx,ny,nz actual field dimensions in x,y and z direction * | |
| 51 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 52 | * x1l,x2l x,y coordinates of lower left subgrid point * | |
| 53 | * x1u,x2u x,y coordinates of upper right subgrid point * | |
| 54 | * xt current x coordinate * | |
| 55 | * y(4,2,3) subset of 4 points for 2 times and 3 levels * | |
| 56 | * ygx(4,2,3) x gradients at 4 points for 2 times and 3 levels * | |
| 57 | * ygy(4,2,3) y gradients at 4 points for 2 times and 3 levels * | |
| 58 | * ygxy(4,2,3) x,y gradients at 4 points for 2 times and 3 levels * | |
| 59 | * yhelp(2,3) the interpolated values for 2 times and 3 levels * | |
| 60 | * yh2(2) the interpolated values for the 2 times * | |
| 61 | * yint the final interpolated value * | |
| 62 | * yt current y coordinate * | |
| 63 | * yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation * | |
| 64 | * zt current z coordinate * | |
| 65 | * * | |
| 66 | ***************************************************************************** | |
| 67 | ||
| 68 | implicit none | |
| 69 | ||
| 70 | integer maxnests,nxn(maxnests),nyn(maxnests),nz,nxmax,nymax,nzmax | |
| 71 | integer ngrid,memind(3),i,j,l,m,n,ix,jy | |
| 72 | integer itime,itime1,itime2,indexf,indz,indexfh,indzh,im,ip,jm,jp | |
| 73 | real yy(0:nxmax-1,0:nymax-1,nzmax,3,maxnests),height(nzmax) | |
| 74 | real y(4,2,3),ygx(4,2,3),ygy(4,2,3),ygxy(4,2,3),yhelp(2,3),yh2(2) | |
| 75 | real x1l,x1u,x2l,x2u,dz1,dz2,dt1,dt2,zz(3) | |
| 76 | real xt,yt,zt,yint | |
| 77 | ||
| 78 | ||
| 79 | C 3 levels are needed for the polynomial interpolation in the vertical | |
| 80 | C Determine the closest vertical level -1 | |
| 81 | ********************************************************************** | |
| 82 | ||
| 83 | do 5 i=1,nz-1 | |
| 84 | if ((height(i).le.zt).and.(height(i+1).ge.zt)) then | |
| 85 | dz1=zt-height(i) | |
| 86 | dz2=height(i+1)-zt | |
| 87 | if (dz1.lt.dz2) then | |
| 88 | indz=i-1 | |
| 89 | else | |
| 90 | indz=i | |
| 91 | endif | |
| 92 | goto 6 | |
| 93 | endif | |
| 94 | 5 continue | |
| 95 | 6 continue | |
| 96 | if (indz.lt.1) indz=1 | |
| 97 | if (indz.gt.(nz-2)) indz=nz-2 | |
| 98 | ||
| 99 | ||
| 100 | C If point at border of grid -> small displacement into grid | |
| 101 | ************************************************************ | |
| 102 | ||
| 103 | if (xt.ge.float(nxn(ngrid)-1)) xt=float(nxn(ngrid)-1)-0.00001 | |
| 104 | if (yt.ge.float(nyn(ngrid)-1)) yt=float(nyn(ngrid)-1)-0.00001 | |
| 105 | ||
| 106 | ||
| 107 | ||
| 108 | *********************************************************************** | |
| 109 | C 1.) Bicubic horizontal interpolation | |
| 110 | C This has to be done separately for 6 fields (Temporal(2)*Vertical(3)) | |
| 111 | *********************************************************************** | |
| 112 | ||
| 113 | C Determine the lower left corner | |
| 114 | ********************************* | |
| 115 | ||
| 116 | ix=int(xt) | |
| 117 | jy=int(yt) | |
| 118 | ||
| 119 | x1l=float(ix) | |
| 120 | x1u=float(ix+1) | |
| 121 | x2l=float(jy) | |
| 122 | x2u=float(jy+1) | |
| 123 | ||
| 124 | ||
| 125 | C Loop over the 2*2 grid points | |
| 126 | ******************************* | |
| 127 | ||
| 128 | do 10 l=1,4 | |
| 129 | if (l.eq.1) then | |
| 130 | i=ix | |
| 131 | j=jy | |
| 132 | else if (l.eq.2) then | |
| 133 | i=ix+1 | |
| 134 | j=jy | |
| 135 | else if (l.eq.3) then | |
| 136 | i=ix+1 | |
| 137 | j=jy+1 | |
| 138 | else if (l.eq.4) then | |
| 139 | i=ix | |
| 140 | j=jy+1 | |
| 141 | endif | |
| 142 | ip=i+1 | |
| 143 | im=i-1 | |
| 144 | jp=j+1 | |
| 145 | jm=j-1 | |
| 146 | ||
| 147 | ||
| 148 | C Loop over 2 time steps and 3 levels | |
| 149 | ************************************* | |
| 150 | ||
| 151 | do 10 m=1,2 | |
| 152 | indexfh=memind(indexf+m-1) | |
| 153 | do 10 n=1,3 | |
| 154 | indzh=indz+n-1 | |
| 155 | ||
| 156 | ||
| 157 | C Values at the 2*2 subgrid | |
| 158 | *************************** | |
| 159 | ||
| 160 | y(l,m,n)=yy(i,j,indzh,indexfh,ngrid) | |
| 161 | ||
| 162 | ||
| 163 | C Calculate derivatives in x-direction on the 2*2 subgrid | |
| 164 | ********************************************************* | |
| 165 | ||
| 166 | if (i.eq.0) then | |
| 167 | ygx(l,m,n) = yy(ip,j ,indzh,indexfh,ngrid) | |
| 168 | + - yy(i ,j ,indzh,indexfh,ngrid) | |
| 169 | else if (i.eq.nxn(ngrid)-1) then | |
| 170 | ygx(l,m,n) = yy(i ,j ,indzh,indexfh,ngrid) | |
| 171 | + - yy(im,j ,indzh,indexfh,ngrid) | |
| 172 | else | |
| 173 | ygx(l,m,n) =(yy(ip,j ,indzh,indexfh,ngrid) | |
| 174 | + - yy(im,j ,indzh,indexfh,ngrid))/2. | |
| 175 | endif | |
| 176 | ||
| 177 | ||
| 178 | C Calculate derivatives in y-direction on the 2*2 subgrid | |
| 179 | ********************************************************* | |
| 180 | ||
| 181 | if (j.eq.0) then | |
| 182 | ygy(l,m,n) = yy(i ,jp,indzh,indexfh,ngrid) | |
| 183 | + - yy(i ,j ,indzh,indexfh,ngrid) | |
| 184 | else if (j.eq.nyn(ngrid)-1) then | |
| 185 | ygy(l,m,n) = yy(i ,j ,indzh,indexfh,ngrid) | |
| 186 | + - yy(i ,jm,indzh,indexfh,ngrid) | |
| 187 | else | |
| 188 | ygy(l,m,n) =(yy(i ,jp,indzh,indexfh,ngrid) | |
| 189 | + - yy(i ,jm,indzh,indexfh,ngrid))/2. | |
| 190 | endif | |
| 191 | ||
| 192 | ||
| 193 | C Calculate cross derivative on the 2*2 subgrid | |
| 194 | *********************************************** | |
| 195 | ||
| 196 | if ((i.eq.0).and.(j.eq.0)) then | |
| 197 | ygxy(l,m,n)= yy(ip,jp,indzh,indexfh,ngrid)- | |
| 198 | + yy(ip,j ,indzh,indexfh,ngrid)- | |
| 199 | + yy(i ,jp,indzh,indexfh,ngrid)+ | |
| 200 | + yy(i ,j ,indzh,indexfh,ngrid) | |
| 201 | else if ((i.eq.nxn(ngrid)-1).and.(j.eq.nyn(ngrid)-1)) then | |
| 202 | ygxy(l,m,n)= yy(i ,j ,indzh,indexfh,ngrid)- | |
| 203 | + yy(i ,jm,indzh,indexfh,ngrid)- | |
| 204 | + yy(im,j ,indzh,indexfh,ngrid)+ | |
| 205 | + yy(im,jm,indzh,indexfh,ngrid) | |
| 206 | else if ((i.eq.0).and.(j.eq.nyn(ngrid)-1)) then | |
| 207 | ygxy(l,m,n)= yy(ip,j ,indzh,indexfh,ngrid)- | |
| 208 | + yy(ip,jm,indzh,indexfh,ngrid)- | |
| 209 | + yy(i ,j ,indzh,indexfh,ngrid)+ | |
| 210 | + yy(i ,jm,indzh,indexfh,ngrid) | |
| 211 | else if ((i.eq.nxn(ngrid)-1).and.(j.eq.0)) then | |
| 212 | ygxy(l,m,n)= yy(i ,jp,indzh,indexfh,ngrid)- | |
| 213 | + yy(i ,j ,indzh,indexfh,ngrid)- | |
| 214 | + yy(im,jp,indzh,indexfh,ngrid)+ | |
| 215 | + yy(im,j ,indzh,indexfh,ngrid) | |
| 216 | else if (i.eq.nxn(ngrid)-1) then | |
| 217 | ygxy(l,m,n)=(yy(i ,jp,indzh,indexfh,ngrid)- | |
| 218 | + yy(i ,jm,indzh,indexfh,ngrid)- | |
| 219 | + yy(im,jp,indzh,indexfh,ngrid)+ | |
| 220 | + yy(im,jm,indzh,indexfh,ngrid))/2. | |
| 221 | else if (i.eq.0) then | |
| 222 | ygxy(l,m,n)=(yy(ip,jp,indzh,indexfh,ngrid)- | |
| 223 | + yy(ip,jm,indzh,indexfh,ngrid)- | |
| 224 | + yy(i ,jp,indzh,indexfh,ngrid)+ | |
| 225 | + yy(i ,jm,indzh,indexfh,ngrid))/2. | |
| 226 | else if (j.eq.nyn(ngrid)-1) then | |
| 227 | ygxy(l,m,n)=(yy(ip,j ,indzh,indexfh,ngrid)- | |
| 228 | + yy(ip,jm,indzh,indexfh,ngrid)- | |
| 229 | + yy(im,j ,indzh,indexfh,ngrid)+ | |
| 230 | + yy(im,jm,indzh,indexfh,ngrid))/2. | |
| 231 | else if (j.eq.0) then | |
| 232 | ygxy(l,m,n)=(yy(ip,jp,indzh,indexfh,ngrid)- | |
| 233 | + yy(ip,j ,indzh,indexfh,ngrid)- | |
| 234 | + yy(im,jp,indzh,indexfh,ngrid)+ | |
| 235 | + yy(im,j ,indzh,indexfh,ngrid))/2. | |
| 236 | else | |
| 237 | ygxy(l,m,n)=(yy(ip,jp,indzh,indexfh,ngrid)- | |
| 238 | + yy(ip,jm,indzh,indexfh,ngrid)- | |
| 239 | + yy(im,jp,indzh,indexfh,ngrid)+ | |
| 240 | + yy(im,jm,indzh,indexfh,ngrid))/4. | |
| 241 | endif | |
| 242 | ||
| 243 | 10 continue | |
| 244 | ||
| 245 | ||
| 246 | C Call bicubic interpolation | |
| 247 | **************************** | |
| 248 | ||
| 249 | call bicubic(y,ygx,ygy,ygxy,x1l,x1u,x2l,x2u,xt,yt,yhelp,2,3) | |
| 250 | ||
| 251 | ||
| 252 | ||
| 253 | ************************************************** | |
| 254 | C 2. Vertical interpolation by a 2nd order polynom | |
| 255 | ************************************************** | |
| 256 | ||
| 257 | do 20 n=1,3 | |
| 258 | 20 zz(n)=height(indz+n-1) | |
| 259 | ||
| 260 | call polynom(zz,yhelp,3,zt,yh2,2) | |
| 261 | ||
| 262 | ||
| 263 | ||
| 264 | ************************************* | |
| 265 | C 3.) Temporal interpolation (linear) | |
| 266 | ************************************* | |
| 267 | ||
| 268 | dt1=float(itime-itime1) | |
| 269 | dt2=float(itime2-itime) | |
| 270 | ||
| 271 | yint=(yh2(1)*dt2+yh2(2)*dt1)/(dt1+dt2) | |
| 272 | ||
| 273 | ||
| 274 | return | |
| 275 | end |
| 0 | FUNCTION juldate(YYYYMMDD,HHMISS) | |
| 1 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
| 2 | * * | |
| 3 | * Calculates the Julian date * | |
| 4 | * * | |
| 5 | * AUTHOR: Andreas Stohl (15 October 1993) * | |
| 6 | * * | |
| 7 | * Variables: * | |
| 8 | * DD Day * | |
| 9 | * HH Hour * | |
| 10 | * HHMISS Hour, minute + second * | |
| 11 | * JA,JM,JY help variables * | |
| 12 | * JULDATE Julian Date * | |
| 13 | * JULDAY help variable * | |
| 14 | * MI Minute * | |
| 15 | * MM Month * | |
| 16 | * SS Second * | |
| 17 | * YYYY Year * | |
| 18 | * YYYYMMDDHH Date and Time * | |
| 19 | * * | |
| 20 | * Constants: * | |
| 21 | * IGREG help constant * | |
| 22 | * * | |
| 23 | * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * | |
| 24 | ||
| 25 | IMPLICIT NONE | |
| 26 | ||
| 27 | INTEGER YYYYMMDD,YYYY,MM,DD,HH,MI,SS,HHMISS | |
| 28 | INTEGER JULDAY,JY,JM,JA,IGREG | |
| 29 | DOUBLE PRECISION JULDATE | |
| 30 | PARAMETER (IGREG=15+31*(10+12*1582)) | |
| 31 | ||
| 32 | YYYY=YYYYMMDD/10000 | |
| 33 | MM=(YYYYMMDD-10000*YYYY)/100 | |
| 34 | DD=YYYYMMDD-10000*YYYY-100*MM | |
| 35 | HH=HHMISS/10000 | |
| 36 | MI=(HHMISS-10000*HH)/100 | |
| 37 | SS=HHMISS-10000*HH-100*MI | |
| 38 | ||
| 39 | IF (YYYY.EQ.0) PAUSE 'There is no Year Zero.' | |
| 40 | IF (YYYY.LT.0) YYYY=YYYY+1 | |
| 41 | IF (MM.GT.2) THEN | |
| 42 | JY=YYYY | |
| 43 | JM=MM+1 | |
| 44 | ELSE | |
| 45 | JY=YYYY-1 | |
| 46 | JM=MM+13 | |
| 47 | ENDIF | |
| 48 | JULDAY=INT(365.25*JY)+INT(30.6001*JM)+DD+1720995 | |
| 49 | IF (DD+31*(MM+12*YYYY).GE.IGREG) THEN | |
| 50 | JA=INT(0.01*JY) | |
| 51 | JULDAY=JULDAY+2-JA+INT(0.25*JA) | |
| 52 | ENDIF | |
| 53 | ||
| 54 | JULDATE=DBLE(FLOAT(JULDAY))+DBLE(FLOAT(HH)/24.)+ | |
| 55 | +DBLE(FLOAT(MI)/1440.)+DBLE(FLOAT(SS)/86400.) | |
| 56 | ||
| 57 | RETURN | |
| 58 | END |
| 0 | subroutine lamphi_ecmwf(xmod,ymod,xlon,ylat) | |
| 1 | C i i o o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine transforms model coordinates to geografical coordinates. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 7 April 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * xmod,ymod model coordinates * | |
| 14 | * xlon,ylat geografical coordinates * | |
| 15 | ||
| 16 | * Constants: * | |
| 17 | * * | |
| 18 | ******************************************************************************** | |
| 19 | ||
| 20 | include 'includepar' | |
| 21 | include 'includecom' | |
| 22 | ||
| 23 | real xlon,ylat,xmod,ymod | |
| 24 | ||
| 25 | ||
| 26 | xlon=xmod*dx+xlon0 | |
| 27 | ylat=ymod*dy+ylat0 | |
| 28 | ||
| 29 | return | |
| 30 | end |
| 0 | subroutine lastprocessor() | |
| 1 | ******************************************************************************** | |
| 2 | * * | |
| 3 | * Back trajectories are produced in the wrong temporal direction by the * | |
| 4 | * trajectory model. This means the first trajectory is the last one in the * | |
| 5 | * file and the last one is the first one. * | |
| 6 | * This routine reverses the direction so that the first date is also first * | |
| 7 | * in the file. * | |
| 8 | * * | |
| 9 | * Author: A. Stohl * | |
| 10 | * * | |
| 11 | * 8 April 1994 * | |
| 12 | * * | |
| 13 | ******************************************************************************** | |
| 14 | * * | |
| 15 | * Variables: * | |
| 16 | * data(maximum) data content of file * | |
| 17 | * header header of file * | |
| 18 | * inter index, if trajectory is interpolated or not * | |
| 19 | * last,numbmax help variables * | |
| 20 | * numpoint number of starting positions = number of output files * | |
| 21 | * * | |
| 22 | * Constants: * | |
| 23 | * maximum maximum number of lines the procedure can handle * | |
| 24 | * * | |
| 25 | ******************************************************************************** | |
| 26 | ||
| 27 | include 'includepar' | |
| 28 | include 'includecom' | |
| 29 | ||
| 30 | integer maximum,numbmax,last,i,j,k | |
| 31 | parameter(maximum=50000) | |
| 32 | character header(98)*70,data(maximum)*80 | |
| 33 | ||
| 34 | ||
| 35 | ||
| 36 | C First: original trajectories (flexible time step) | |
| 37 | *************************************************** | |
| 38 | ||
| 39 | if ((inter.eq.0).or.(inter.eq.2)) then | |
| 40 | ||
| 41 | C Reverse direction only for back trajectories. | |
| 42 | C Read whole output file and store it in memory. | |
| 43 | ************************************************ | |
| 44 | ||
| 45 | if (ldirect.eq.-1) then | |
| 46 | do 10 i=1,numpoint ! loop over all starting points=files | |
| 47 | rewind(unittraj+i) | |
| 48 | do 20 j=1,42+4*numbnests | |
| 49 | 20 read(unittraj+i,'(a)') header(j) | |
| 50 | do 30 j=1,maximum | |
| 51 | 30 read(unittraj+i,'(a)',end=35) data(j) | |
| 52 | ||
| 53 | 35 numbmax=j-1 | |
| 54 | ||
| 55 | ||
| 56 | C If content of file exceeds available memory, don't reverse file | |
| 57 | ***************************************************************** | |
| 58 | ||
| 59 | if (numbmax.eq.maximum) then | |
| 60 | k=index(compoint(i),' ')-1 | |
| 61 | k=min(k,7) | |
| 62 | write(*,*) '!!! Warning !!! The content of file:' | |
| 63 | if (compoint(i)(41:41).ne.'U') then ! no uncertainty trajectory | |
| 64 | write(*,*) 'T_'//compoint(i)(1:k) | |
| 65 | else | |
| 66 | write(*,*) 'T_'//compoint(i)(1:k)//'_U'//compoint(i) | |
| 67 | + (42:45) | |
| 68 | endif | |
| 69 | write(*,*) 'is too long for postprocessing.' | |
| 70 | write(*,*) 'Please use manual postprocessor!' | |
| 71 | write(*,*) | |
| 72 | goto 10 | |
| 73 | endif | |
| 74 | ||
| 75 | C Rewind file and write it new with reversed direction | |
| 76 | ****************************************************** | |
| 77 | ||
| 78 | rewind(unittraj+i) | |
| 79 | do 40 j=1,42+4*numbnests | |
| 80 | 40 write(unittraj+i,'(a)') header(j) | |
| 81 | last=numbmax | |
| 82 | do 50 j=numbmax,1,-1 | |
| 83 | if (data(j)(1:1).eq.'D') then | |
| 84 | write(unittraj+i,'(a)') data(j) | |
| 85 | do 60 k=j+1,last | |
| 86 | 60 write(unittraj+i,'(a)') data(k) | |
| 87 | last=j-1 | |
| 88 | endif | |
| 89 | 50 continue | |
| 90 | 10 continue | |
| 91 | ||
| 92 | endif | |
| 93 | ||
| 94 | C Close output files | |
| 95 | ******************** | |
| 96 | ||
| 97 | do 70 i=1,numpoint | |
| 98 | 70 close(unittraj+i) | |
| 99 | endif | |
| 100 | ||
| 101 | ||
| 102 | ||
| 103 | C Second: interpolated trajectories (constant time step) | |
| 104 | ******************************************************** | |
| 105 | ||
| 106 | if (inter.ge.1) then | |
| 107 | ||
| 108 | C Reverse direction only for back trajectories. | |
| 109 | C Read whole output file and store it in memory. | |
| 110 | ************************************************ | |
| 111 | ||
| 112 | if (ldirect.eq.-1) then | |
| 113 | do 110 i=1,numpoint ! loop over all starting points=files | |
| 114 | rewind(unittraji+i) | |
| 115 | do 120 j=1,42+4*numbnests | |
| 116 | 120 read(unittraji+i,'(a)') header(j) | |
| 117 | do 130 j=1,maximum | |
| 118 | 130 read(unittraji+i,'(a)',end=135) data(j) | |
| 119 | ||
| 120 | 135 numbmax=j-1 | |
| 121 | ||
| 122 | ||
| 123 | C If content of file exceeds available memory, don't reverse file | |
| 124 | ***************************************************************** | |
| 125 | ||
| 126 | if (numbmax.eq.maximum) then | |
| 127 | k=index(compoint(i),' ')-1 | |
| 128 | k=min(k,7) | |
| 129 | write(*,*) '!!! Warning !!! The content of file:' | |
| 130 | if (compoint(i)(41:41).ne.'U') then ! no uncertainty trajectory | |
| 131 | write(*,*) 'TI_'//compoint(i)(1:k) | |
| 132 | else | |
| 133 | write(*,*) 'TI_'//compoint(i)(1:k)//'_U'//compoint(i) | |
| 134 | + (42:45) | |
| 135 | endif | |
| 136 | write(*,*) 'is too long for postprocessing.' | |
| 137 | write(*,*) 'Please use manual postprocessor!' | |
| 138 | write(*,*) | |
| 139 | goto 110 | |
| 140 | endif | |
| 141 | ||
| 142 | ||
| 143 | C Rewind file and write it new with reversed direction | |
| 144 | ****************************************************** | |
| 145 | ||
| 146 | rewind(unittraji+i) | |
| 147 | do 140 j=1,42+4*numbnests | |
| 148 | 140 write(unittraji+i,'(a)') header(j) | |
| 149 | last=numbmax | |
| 150 | do 150 j=numbmax,1,-1 | |
| 151 | if (data(j)(1:1).eq.'D') then | |
| 152 | write(unittraji+i,'(a)') data(j) | |
| 153 | do 160 k=j+1,last | |
| 154 | 160 write(unittraji+i,'(a)') data(k) | |
| 155 | last=j-1 | |
| 156 | endif | |
| 157 | 150 continue | |
| 158 | 110 continue | |
| 159 | ||
| 160 | endif | |
| 161 | ||
| 162 | ||
| 163 | C Close output files and go for a coffee | |
| 164 | **************************************** | |
| 165 | ||
| 166 | do 170 i=1,numpoint | |
| 167 | 170 close(unittraji+i) | |
| 168 | endif | |
| 169 | ||
| 170 | ||
| 171 | ||
| 172 | return | |
| 173 | end |
| 0 | subroutine levinterpol(yy,nxmax,nymax,nzmax,nx,ny,memind, | |
| 1 | +xt,yt,level,itime1,itime2,itime,indexf,yint) | |
| 2 | C i i i i i i i | |
| 3 | C i i i i i i i o | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of 3-dimensional meteorological fields. * | |
| 7 | * In horizontal direction bicubic interpolation interpolation is used. * | |
| 8 | * In the temporal direction linear interpolation is used. * | |
| 9 | * These interpolation techniques have been found to be most accurate. * | |
| 10 | * * | |
| 11 | * The interpolation routines have been taken from: * | |
| 12 | * Press W.H. et al. (1992): Numerical Recipes in FORTRAN. The art of * | |
| 13 | * scientific computing. 2nd edition. Cambridge University Press. * | |
| 14 | * * | |
| 15 | * But they have been modified for faster performance. * | |
| 16 | * * | |
| 17 | * 4-3 * | |
| 18 | * | | The points are numbered in this order. Values and gradients are * | |
| 19 | * 1-2 stored in fields with dimension 4. * | |
| 20 | * * | |
| 21 | * 1 is the first time * | |
| 22 | * 2 is the second time * | |
| 23 | * * | |
| 24 | * * | |
| 25 | * Author: A. Stohl * | |
| 26 | * * | |
| 27 | * 30 May 1994 * | |
| 28 | * * | |
| 29 | ***************************************************************************** | |
| 30 | * * | |
| 31 | * Variables: * | |
| 32 | * * | |
| 33 | * dt1,dt2 time differences between fields and current position * | |
| 34 | * indexf indicates the number of the wind field to be read in * | |
| 35 | * indexfh help variable * | |
| 36 | * level help variable * | |
| 37 | * itime current time * | |
| 38 | * itime1 time of the first wind field * | |
| 39 | * itime2 time of the second wind field * | |
| 40 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 41 | * level level for which interpolation shall be done * | |
| 42 | * memind(3) points to the places of the wind fields * | |
| 43 | * nx,ny actual field dimensions in x,y and z direction * | |
| 44 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 45 | * x1l,x2l x,y coordinates of lower left subgrid point * | |
| 46 | * x1u,x2u x,y coordinates of upper right subgrid point * | |
| 47 | * xt current x coordinate * | |
| 48 | * y(4,2,1) subset of 4 points for 2 times and 1 level * | |
| 49 | * ygx(4,2,1) x gradients at 4 points for 2 times and 1 level * | |
| 50 | * ygy(4,2,1) y gradients at 4 points for 2 times and 1 level * | |
| 51 | * ygxy(4,2,1) x,y gradients at 4 points for 2 times and 1 level * | |
| 52 | * yhelp(2,1) the interpolated values for 2 times and 1 level * | |
| 53 | * yint the final interpolated value * | |
| 54 | * yt current y coordinate * | |
| 55 | * yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation * | |
| 56 | * * | |
| 57 | ***************************************************************************** | |
| 58 | ||
| 59 | implicit none | |
| 60 | ||
| 61 | integer nx,ny,nxmax,nymax,nzmax,memind(3),i,j,l,m,n,ix,jy | |
| 62 | integer level,itime,itime1,itime2,indexf,indexfh,im,ip,jm,jp | |
| 63 | real yy(0:nxmax-1,0:nymax-1,nzmax,3) | |
| 64 | real y(4,2,1),ygx(4,2,1),ygy(4,2,1),ygxy(4,2,1),yhelp(2,1) | |
| 65 | real x1l,x1u,x2l,x2u,dt1,dt2 | |
| 66 | real xt,yt,yint | |
| 67 | ||
| 68 | ||
| 69 | ||
| 70 | C If point at border of grid -> small displacement into grid | |
| 71 | ************************************************************ | |
| 72 | ||
| 73 | if (xt.ge.float(nx-1)) xt=float(nx-1)-0.00001 | |
| 74 | if (yt.ge.float(ny-1)) yt=float(ny-1)-0.00001 | |
| 75 | ||
| 76 | ||
| 77 | ||
| 78 | *********************************************************************** | |
| 79 | C 1.) Bicubic horizontal interpolation | |
| 80 | C This has to be done separately for 2 fields (Temporal) | |
| 81 | *********************************************************************** | |
| 82 | ||
| 83 | C Determine the lower left corner | |
| 84 | ********************************* | |
| 85 | ||
| 86 | ix=int(xt) | |
| 87 | jy=int(yt) | |
| 88 | ||
| 89 | x1l=float(ix) | |
| 90 | x1u=float(ix+1) | |
| 91 | x2l=float(jy) | |
| 92 | x2u=float(jy+1) | |
| 93 | ||
| 94 | ||
| 95 | C Loop over the 2*2 grid points | |
| 96 | ******************************* | |
| 97 | ||
| 98 | do 10 l=1,4 | |
| 99 | if (l.eq.1) then | |
| 100 | i=ix | |
| 101 | j=jy | |
| 102 | else if (l.eq.2) then | |
| 103 | i=ix+1 | |
| 104 | j=jy | |
| 105 | else if (l.eq.3) then | |
| 106 | i=ix+1 | |
| 107 | j=jy+1 | |
| 108 | else if (l.eq.4) then | |
| 109 | i=ix | |
| 110 | j=jy+1 | |
| 111 | endif | |
| 112 | ip=i+1 | |
| 113 | im=i-1 | |
| 114 | jp=j+1 | |
| 115 | jm=j-1 | |
| 116 | ||
| 117 | ||
| 118 | C Loop over 2 time steps and 3 levels | |
| 119 | ************************************* | |
| 120 | ||
| 121 | do 10 m=1,2 | |
| 122 | do 10 n=1,1 ! this loop and dimension is necessary to be in | |
| 123 | ! agreement with the full 3-d interpolation | |
| 124 | ||
| 125 | indexfh=memind(indexf+m-1) | |
| 126 | ||
| 127 | ||
| 128 | C Values at the 2*2 subgrid | |
| 129 | *************************** | |
| 130 | ||
| 131 | y(l,m,n)=yy(i,j,level,indexfh) | |
| 132 | ||
| 133 | ||
| 134 | C Calculate derivatives in x-direction on the 2*2 subgrid | |
| 135 | ********************************************************* | |
| 136 | ||
| 137 | if (i.eq.0) then | |
| 138 | ygx(l,m,n) = yy(ip,j ,level,indexfh) | |
| 139 | + - yy(i ,j ,level,indexfh) | |
| 140 | else if (i.eq.nx-1) then | |
| 141 | ygx(l,m,n) = yy(i ,j ,level,indexfh) | |
| 142 | + - yy(im,j ,level,indexfh) | |
| 143 | else | |
| 144 | ygx(l,m,n) =(yy(ip,j ,level,indexfh) | |
| 145 | + - yy(im,j ,level,indexfh))/2. | |
| 146 | endif | |
| 147 | ||
| 148 | ||
| 149 | C Calculate derivatives in y-direction on the 2*2 subgrid | |
| 150 | ********************************************************* | |
| 151 | ||
| 152 | if (j.eq.0) then | |
| 153 | ygy(l,m,n) = yy(i ,jp,level,indexfh) | |
| 154 | + - yy(i ,j ,level,indexfh) | |
| 155 | else if (j.eq.ny-1) then | |
| 156 | ygy(l,m,n) = yy(i ,j ,level,indexfh) | |
| 157 | + - yy(i ,jm,level,indexfh) | |
| 158 | else | |
| 159 | ygy(l,m,n) =(yy(i ,jp,level,indexfh) | |
| 160 | + - yy(i ,jm,level,indexfh))/2. | |
| 161 | endif | |
| 162 | ||
| 163 | ||
| 164 | C Calculate cross derivative on the 2*2 subgrid | |
| 165 | *********************************************** | |
| 166 | ||
| 167 | if ((i.eq.0).and.(j.eq.0)) then | |
| 168 | ygxy(l,m,n)= yy(ip,jp,level,indexfh)- | |
| 169 | + yy(ip,j ,level,indexfh)- | |
| 170 | + yy(i ,jp,level,indexfh)+ | |
| 171 | + yy(i ,j ,level,indexfh) | |
| 172 | else if ((i.eq.nx-1).and.(j.eq.ny-1)) then | |
| 173 | ygxy(l,m,n)= yy(i ,j ,level,indexfh)- | |
| 174 | + yy(i ,jm,level,indexfh)- | |
| 175 | + yy(im,j ,level,indexfh)+ | |
| 176 | + yy(im,jm,level,indexfh) | |
| 177 | else if ((i.eq.0).and.(j.eq.ny-1)) then | |
| 178 | ygxy(l,m,n)= yy(ip,j ,level,indexfh)- | |
| 179 | + yy(ip,jm,level,indexfh)- | |
| 180 | + yy(i ,j ,level,indexfh)+ | |
| 181 | + yy(i ,jm,level,indexfh) | |
| 182 | else if ((i.eq.nx-1).and.(j.eq.0)) then | |
| 183 | ygxy(l,m,n)= yy(i ,jp,level,indexfh)- | |
| 184 | + yy(i ,j ,level,indexfh)- | |
| 185 | + yy(im,jp,level,indexfh)+ | |
| 186 | + yy(im,j ,level,indexfh) | |
| 187 | else if (i.eq.nx-1) then | |
| 188 | ygxy(l,m,n)=(yy(i ,jp,level,indexfh)- | |
| 189 | + yy(i ,jm,level,indexfh)- | |
| 190 | + yy(im,jp,level,indexfh)+ | |
| 191 | + yy(im,jm,level,indexfh))/2. | |
| 192 | else if (i.eq.0) then | |
| 193 | ygxy(l,m,n)=(yy(ip,jp,level,indexfh)- | |
| 194 | + yy(ip,jm,level,indexfh)- | |
| 195 | + yy(i ,jp,level,indexfh)+ | |
| 196 | + yy(i ,jm,level,indexfh))/2. | |
| 197 | else if (j.eq.ny-1) then | |
| 198 | ygxy(l,m,n)=(yy(ip,j ,level,indexfh)- | |
| 199 | + yy(ip,jm,level,indexfh)- | |
| 200 | + yy(im,j ,level,indexfh)+ | |
| 201 | + yy(im,jm,level,indexfh))/2. | |
| 202 | else if (j.eq.0) then | |
| 203 | ygxy(l,m,n)=(yy(ip,jp,level,indexfh)- | |
| 204 | + yy(ip,j ,level,indexfh)- | |
| 205 | + yy(im,jp,level,indexfh)+ | |
| 206 | + yy(im,j ,level,indexfh))/2. | |
| 207 | else | |
| 208 | ygxy(l,m,n)=(yy(ip,jp,level,indexfh)- | |
| 209 | + yy(ip,jm,level,indexfh)- | |
| 210 | + yy(im,jp,level,indexfh)+ | |
| 211 | + yy(im,jm,level,indexfh))/4. | |
| 212 | endif | |
| 213 | ||
| 214 | 10 continue | |
| 215 | ||
| 216 | ||
| 217 | C Call bicubic interpolation | |
| 218 | **************************** | |
| 219 | ||
| 220 | call bicubic(y,ygx,ygy,ygxy,x1l,x1u,x2l,x2u,xt,yt,yhelp,2,1) | |
| 221 | ||
| 222 | ||
| 223 | ||
| 224 | ************************************* | |
| 225 | C 2.) Temporal interpolation (linear) | |
| 226 | ************************************* | |
| 227 | ||
| 228 | dt1=float(itime-itime1) | |
| 229 | dt2=float(itime2-itime) | |
| 230 | ||
| 231 | yint=(yhelp(1,1)*dt2+yhelp(2,1)*dt1)/(dt1+dt2) | |
| 232 | ||
| 233 | ||
| 234 | return | |
| 235 | end |
| 0 | subroutine levinterpoln(yy,maxnests,nxmax,nymax,nzmax,ngrid, | |
| 1 | +nxn,nyn,memind,xt,yt,level,itime1,itime2,itime,indexf,yint) | |
| 2 | C i i i i i i | |
| 3 | C i i i i i i i i i i i | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of nested 3-dimensional meteorological fields. * | |
| 7 | * In horizontal direction bicubic interpolation interpolation is used. * | |
| 8 | * In the temporal direction linear interpolation is used. * | |
| 9 | * These interpolation techniques have been found to be most accurate. * | |
| 10 | * * | |
| 11 | * The interpolation routines have been taken from: * | |
| 12 | * Press W.H. et al. (1992): Numerical Recipes in FORTRAN. The art of * | |
| 13 | * scientific computing. 2nd edition. Cambridge University Press. * | |
| 14 | * * | |
| 15 | * But they have been modified for faster performance. * | |
| 16 | * * | |
| 17 | * 4-3 * | |
| 18 | * | | The points are numbered in this order. Values and gradients are * | |
| 19 | * 1-2 stored in fields with dimension 4. * | |
| 20 | * * | |
| 21 | * 1 is the first time * | |
| 22 | * 2 is the second time * | |
| 23 | * * | |
| 24 | * * | |
| 25 | * Author: A. Stohl * | |
| 26 | * * | |
| 27 | * 30 May 1994 * | |
| 28 | * * | |
| 29 | ***************************************************************************** | |
| 30 | * * | |
| 31 | * Variables: * | |
| 32 | * * | |
| 33 | * dt1,dt2 time differences between fields and current position * | |
| 34 | * indexf indicates the number of the wind field to be read in * | |
| 35 | * indexfh help variable * | |
| 36 | * level help variable * | |
| 37 | * itime current time * | |
| 38 | * itime1 time of the first wind field * | |
| 39 | * itime2 time of the second wind field * | |
| 40 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 41 | * level level for which interpolation shall be done * | |
| 42 | * memind(3) points to the places of the wind fields * | |
| 43 | * nx,ny actual field dimensions in x,y and z direction * | |
| 44 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 45 | * x1l,x2l x,y coordinates of lower left subgrid point * | |
| 46 | * x1u,x2u x,y coordinates of upper right subgrid point * | |
| 47 | * xt current x coordinate * | |
| 48 | * y(4,2,1) subset of 4 points for 2 times and 1 level * | |
| 49 | * ygx(4,2,1) x gradients at 4 points for 2 times and 1 level * | |
| 50 | * ygy(4,2,1) y gradients at 4 points for 2 times and 1 level * | |
| 51 | * ygxy(4,2,1) x,y gradients at 4 points for 2 times and 1 level * | |
| 52 | * yhelp(2,1) the interpolated values for 2 times and 1 level * | |
| 53 | * yint the final interpolated value * | |
| 54 | * yt current y coordinate * | |
| 55 | * yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation * | |
| 56 | * * | |
| 57 | ***************************************************************************** | |
| 58 | ||
| 59 | implicit none | |
| 60 | ||
| 61 | integer maxnests,nxn(maxnests),nyn(maxnests),nxmax,nymax,nzmax | |
| 62 | integer memind(3),i,j,l,m,n,ngrid,ix,jy | |
| 63 | integer level,itime,itime1,itime2,indexf,indexfh,im,ip,jm,jp | |
| 64 | real yy(0:nxmax-1,0:nymax-1,nzmax,3,maxnests) | |
| 65 | real y(4,2,1),ygx(4,2,1),ygy(4,2,1),ygxy(4,2,1),yhelp(2,1) | |
| 66 | real x1l,x1u,x2l,x2u,dt1,dt2 | |
| 67 | real xt,yt,yint | |
| 68 | ||
| 69 | ||
| 70 | ||
| 71 | C If point at border of grid -> small displacement into grid | |
| 72 | ************************************************************ | |
| 73 | ||
| 74 | if (xt.ge.float(nxn(ngrid)-1)) xt=float(nxn(ngrid)-1)-0.00001 | |
| 75 | if (yt.ge.float(nyn(ngrid)-1)) yt=float(nyn(ngrid)-1)-0.00001 | |
| 76 | ||
| 77 | ||
| 78 | ||
| 79 | *********************************************************************** | |
| 80 | C 1.) Bicubic horizontal interpolation | |
| 81 | C This has to be done separately for 2 fields (Temporal) | |
| 82 | *********************************************************************** | |
| 83 | ||
| 84 | C Determine the lower left corner | |
| 85 | ********************************* | |
| 86 | ||
| 87 | ix=int(xt) | |
| 88 | jy=int(yt) | |
| 89 | ||
| 90 | x1l=float(ix) | |
| 91 | x1u=float(ix+1) | |
| 92 | x2l=float(jy) | |
| 93 | x2u=float(jy+1) | |
| 94 | ||
| 95 | ||
| 96 | C Loop over the 2*2 grid points | |
| 97 | ******************************* | |
| 98 | ||
| 99 | do 10 l=1,4 | |
| 100 | if (l.eq.1) then | |
| 101 | i=ix | |
| 102 | j=jy | |
| 103 | else if (l.eq.2) then | |
| 104 | i=ix+1 | |
| 105 | j=jy | |
| 106 | else if (l.eq.3) then | |
| 107 | i=ix+1 | |
| 108 | j=jy+1 | |
| 109 | else if (l.eq.4) then | |
| 110 | i=ix | |
| 111 | j=jy+1 | |
| 112 | endif | |
| 113 | ip=i+1 | |
| 114 | im=i-1 | |
| 115 | jp=j+1 | |
| 116 | jm=j-1 | |
| 117 | ||
| 118 | ||
| 119 | C Loop over 2 time steps and 3 levels | |
| 120 | ************************************* | |
| 121 | ||
| 122 | do 10 m=1,2 | |
| 123 | do 10 n=1,1 ! this loop and dimension is necessary to be in | |
| 124 | ! agreement with the full 3-d interpolation | |
| 125 | ||
| 126 | indexfh=memind(indexf+m-1) | |
| 127 | ||
| 128 | ||
| 129 | C Values at the 2*2 subgrid | |
| 130 | *************************** | |
| 131 | ||
| 132 | y(l,m,n)=yy(i,j,level,indexfh,ngrid) | |
| 133 | ||
| 134 | ||
| 135 | C Calculate derivatives in x-direction on the 2*2 subgrid | |
| 136 | ********************************************************* | |
| 137 | ||
| 138 | if (i.eq.0) then | |
| 139 | ygx(l,m,n) = yy(ip,j ,level,indexfh,ngrid) | |
| 140 | + - yy(i ,j ,level,indexfh,ngrid) | |
| 141 | else if (i.eq.nxn(ngrid)-1) then | |
| 142 | ygx(l,m,n) = yy(i ,j ,level,indexfh,ngrid) | |
| 143 | + - yy(im,j ,level,indexfh,ngrid) | |
| 144 | else | |
| 145 | ygx(l,m,n) =(yy(ip,j ,level,indexfh,ngrid) | |
| 146 | + - yy(im,j ,level,indexfh,ngrid))/2. | |
| 147 | endif | |
| 148 | ||
| 149 | ||
| 150 | C Calculate derivatives in y-direction on the 2*2 subgrid | |
| 151 | ********************************************************* | |
| 152 | ||
| 153 | if (j.eq.0) then | |
| 154 | ygy(l,m,n) = yy(i ,jp,level,indexfh,ngrid) | |
| 155 | + - yy(i ,j ,level,indexfh,ngrid) | |
| 156 | else if (j.eq.nyn(ngrid)-1) then | |
| 157 | ygy(l,m,n) = yy(i ,j ,level,indexfh,ngrid) | |
| 158 | + - yy(i ,jm,level,indexfh,ngrid) | |
| 159 | else | |
| 160 | ygy(l,m,n) =(yy(i ,jp,level,indexfh,ngrid) | |
| 161 | + - yy(i ,jm,level,indexfh,ngrid))/2. | |
| 162 | endif | |
| 163 | ||
| 164 | ||
| 165 | C Calculate cross derivative on the 2*2 subgrid | |
| 166 | *********************************************** | |
| 167 | ||
| 168 | if ((i.eq.0).and.(j.eq.0)) then | |
| 169 | ygxy(l,m,n)= yy(ip,jp,level,indexfh,ngrid)- | |
| 170 | + yy(ip,j ,level,indexfh,ngrid)- | |
| 171 | + yy(i ,jp,level,indexfh,ngrid)+ | |
| 172 | + yy(i ,j ,level,indexfh,ngrid) | |
| 173 | else if ((i.eq.nxn(ngrid)-1).and.(j.eq.nyn(ngrid)-1)) then | |
| 174 | ygxy(l,m,n)= yy(i ,j ,level,indexfh,ngrid)- | |
| 175 | + yy(i ,jm,level,indexfh,ngrid)- | |
| 176 | + yy(im,j ,level,indexfh,ngrid)+ | |
| 177 | + yy(im,jm,level,indexfh,ngrid) | |
| 178 | else if ((i.eq.0).and.(j.eq.nyn(ngrid)-1)) then | |
| 179 | ygxy(l,m,n)= yy(ip,j ,level,indexfh,ngrid)- | |
| 180 | + yy(ip,jm,level,indexfh,ngrid)- | |
| 181 | + yy(i ,j ,level,indexfh,ngrid)+ | |
| 182 | + yy(i ,jm,level,indexfh,ngrid) | |
| 183 | else if ((i.eq.nxn(ngrid)-1).and.(j.eq.0)) then | |
| 184 | ygxy(l,m,n)= yy(i ,jp,level,indexfh,ngrid)- | |
| 185 | + yy(i ,j ,level,indexfh,ngrid)- | |
| 186 | + yy(im,jp,level,indexfh,ngrid)+ | |
| 187 | + yy(im,j ,level,indexfh,ngrid) | |
| 188 | else if (i.eq.nxn(ngrid)-1) then | |
| 189 | ygxy(l,m,n)=(yy(i ,jp,level,indexfh,ngrid)- | |
| 190 | + yy(i ,jm,level,indexfh,ngrid)- | |
| 191 | + yy(im,jp,level,indexfh,ngrid)+ | |
| 192 | + yy(im,jm,level,indexfh,ngrid))/2. | |
| 193 | else if (i.eq.0) then | |
| 194 | ygxy(l,m,n)=(yy(ip,jp,level,indexfh,ngrid)- | |
| 195 | + yy(ip,jm,level,indexfh,ngrid)- | |
| 196 | + yy(i ,jp,level,indexfh,ngrid)+ | |
| 197 | + yy(i ,jm,level,indexfh,ngrid))/2. | |
| 198 | else if (j.eq.nyn(ngrid)-1) then | |
| 199 | ygxy(l,m,n)=(yy(ip,j ,level,indexfh,ngrid)- | |
| 200 | + yy(ip,jm,level,indexfh,ngrid)- | |
| 201 | + yy(im,j ,level,indexfh,ngrid)+ | |
| 202 | + yy(im,jm,level,indexfh,ngrid))/2. | |
| 203 | else if (j.eq.0) then | |
| 204 | ygxy(l,m,n)=(yy(ip,jp,level,indexfh,ngrid)- | |
| 205 | + yy(ip,j ,level,indexfh,ngrid)- | |
| 206 | + yy(im,jp,level,indexfh,ngrid)+ | |
| 207 | + yy(im,j ,level,indexfh,ngrid))/2. | |
| 208 | else | |
| 209 | ygxy(l,m,n)=(yy(ip,jp,level,indexfh,ngrid)- | |
| 210 | + yy(ip,jm,level,indexfh,ngrid)- | |
| 211 | + yy(im,jp,level,indexfh,ngrid)+ | |
| 212 | + yy(im,jm,level,indexfh,ngrid))/4. | |
| 213 | endif | |
| 214 | ||
| 215 | 10 continue | |
| 216 | ||
| 217 | ||
| 218 | C Call bicubic interpolation | |
| 219 | **************************** | |
| 220 | ||
| 221 | call bicubic(y,ygx,ygy,ygxy,x1l,x1u,x2l,x2u,xt,yt,yhelp,2,1) | |
| 222 | ||
| 223 | ||
| 224 | ||
| 225 | ************************************* | |
| 226 | C 2.) Temporal interpolation (linear) | |
| 227 | ************************************* | |
| 228 | ||
| 229 | dt1=float(itime-itime1) | |
| 230 | dt2=float(itime2-itime) | |
| 231 | ||
| 232 | yint=(yhelp(1,1)*dt2+yhelp(2,1)*dt1)/(dt1+dt2) | |
| 233 | ||
| 234 | ||
| 235 | return | |
| 236 | end |
| 0 | subroutine levlininterpol(yy,nxmax,nymax,nzmax,nx,ny,memind, | |
| 1 | +xt,yt,level,itime1,itime2,itime,indexf,yint) | |
| 2 | C i i i i i i i | |
| 3 | C i i i i i i i o | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of meteorological fields on 2-d model layers. * | |
| 7 | * In horizontal direction bilinear interpolation interpolation is used. * | |
| 8 | * Temporally a linear interpolation is used. * | |
| 9 | * * | |
| 10 | * 1 first time * | |
| 11 | * 2 second time * | |
| 12 | * * | |
| 13 | * * | |
| 14 | * Author: A. Stohl * | |
| 15 | * * | |
| 16 | * 30 May 1994 * | |
| 17 | * * | |
| 18 | ***************************************************************************** | |
| 19 | * * | |
| 20 | * Variables: * | |
| 21 | * * | |
| 22 | * dt1,dt2 time differences between fields and current position * | |
| 23 | * dz1,dz2 z distance between levels and current position * | |
| 24 | * height(nzmax) heights of the model levels * | |
| 25 | * indexf indicates the number of the wind field to be read in * | |
| 26 | * indexfh help variable * | |
| 27 | * indz the level closest to the current trajectory position * | |
| 28 | * indzh help variable * | |
| 29 | * itime current time * | |
| 30 | * itime1 time of the first wind field * | |
| 31 | * itime2 time of the second wind field * | |
| 32 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 33 | * level level at which interpolation shall be done * | |
| 34 | * memind(3) points to the places of the wind fields * | |
| 35 | * nx,ny actual field dimensions in x,y and z direction * | |
| 36 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 37 | * xt current x coordinate * | |
| 38 | * yint the final interpolated value * | |
| 39 | * yt current y coordinate * | |
| 40 | * yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation * | |
| 41 | * zt current z coordinate * | |
| 42 | * * | |
| 43 | ***************************************************************************** | |
| 44 | ||
| 45 | implicit none | |
| 46 | ||
| 47 | integer nx,ny,nxmax,nymax,nzmax,memind(3),m,ix,jy,ixp,jyp | |
| 48 | integer itime,itime1,itime2,level,indexf,indexfh | |
| 49 | real yy(0:nxmax-1,0:nymax-1,nzmax,3) | |
| 50 | real ddx,ddy,rddx,rddy,dt1,dt2,y(2) | |
| 51 | real xt,yt,yint | |
| 52 | ||
| 53 | ||
| 54 | ||
| 55 | C If point at border of grid -> small displacement into grid | |
| 56 | ************************************************************ | |
| 57 | ||
| 58 | if (xt.ge.float(nx-1)) xt=float(nx-1)-0.00001 | |
| 59 | if (yt.ge.float(ny-1)) yt=float(ny-1)-0.00001 | |
| 60 | ||
| 61 | ||
| 62 | ||
| 63 | *********************************************************************** | |
| 64 | C 1.) Bilinear horizontal interpolation | |
| 65 | C This has to be done separately for 2 fields (Temporal) | |
| 66 | ******************************************************** | |
| 67 | ||
| 68 | C Determine the lower left corner and its distance to the current position | |
| 69 | ************************************************************************** | |
| 70 | ||
| 71 | ix=int(xt) | |
| 72 | jy=int(yt) | |
| 73 | ixp=ix+1 | |
| 74 | jyp=jy+1 | |
| 75 | ddx=xt-float(ix) | |
| 76 | ddy=yt-float(jy) | |
| 77 | rddx=1.-ddx | |
| 78 | rddy=1.-ddy | |
| 79 | ||
| 80 | ||
| 81 | C Loop over 2 time steps | |
| 82 | ************************ | |
| 83 | ||
| 84 | do 10 m=1,2 | |
| 85 | indexfh=memind(indexf+m-1) | |
| 86 | ||
| 87 | 10 y(m)=rddx*rddy*yy(ix ,jy ,level,indexfh) | |
| 88 | + + ddx*rddy*yy(ixp,jy ,level,indexfh) | |
| 89 | + +rddx* ddy*yy(ix ,jyp,level,indexfh) | |
| 90 | + + ddx* ddy*yy(ixp,jyp,level,indexfh) | |
| 91 | ||
| 92 | ||
| 93 | ************************************* | |
| 94 | C 2.) Temporal interpolation (linear) | |
| 95 | ************************************* | |
| 96 | ||
| 97 | dt1=float(itime-itime1) | |
| 98 | dt2=float(itime2-itime) | |
| 99 | ||
| 100 | yint=(y(1)*dt2+y(2)*dt1)/(dt1+dt2) | |
| 101 | ||
| 102 | ||
| 103 | return | |
| 104 | end |
| 0 | subroutine levlininterpoln(yy,maxnests,nxmax,nymax,nzmax,ngrid, | |
| 1 | +nxn,nyn,memind,xt,yt,level,itime1,itime2,itime,index,yint) | |
| 2 | C i i i i i i | |
| 3 | C i i i i i i i i i i i | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of meteorological fields on 2-d model layers. * | |
| 7 | * In horizontal direction bilinear interpolation interpolation is used. * | |
| 8 | * Temporally a linear interpolation is used. * | |
| 9 | * * | |
| 10 | * 1 first time * | |
| 11 | * 2 second time * | |
| 12 | * * | |
| 13 | * * | |
| 14 | * Author: A. Stohl * | |
| 15 | * * | |
| 16 | * 30 May 1994 * | |
| 17 | * * | |
| 18 | ***************************************************************************** | |
| 19 | * * | |
| 20 | * Variables: * | |
| 21 | * * | |
| 22 | * dt1,dt2 time differences between fields and current position * | |
| 23 | * dz1,dz2 z distance between levels and current position * | |
| 24 | * height(nzmax) heights of the model levels * | |
| 25 | * index indicates the number of the wind field to be read in * | |
| 26 | * indexh help variable * | |
| 27 | * indz the level closest to the current trajectory position * | |
| 28 | * indzh help variable * | |
| 29 | * itime current time * | |
| 30 | * itime1 time of the first wind field * | |
| 31 | * itime2 time of the second wind field * | |
| 32 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 33 | * level level at which interpolation shall be done * | |
| 34 | * memind(3) points to the places of the wind fields * | |
| 35 | * nx,ny actual field dimensions in x,y and z direction * | |
| 36 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 37 | * xt current x coordinate * | |
| 38 | * yint the final interpolated value * | |
| 39 | * yt current y coordinate * | |
| 40 | * yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation * | |
| 41 | * zt current z coordinate * | |
| 42 | * * | |
| 43 | ***************************************************************************** | |
| 44 | ||
| 45 | implicit none | |
| 46 | ||
| 47 | integer maxnests,nxn(maxnests),nyn(maxnests),nxmax,nymax,nzmax | |
| 48 | integer ngrid,memind(3),m,ix,jy,ixp,jyp | |
| 49 | integer itime,itime1,itime2,level,index,indexh | |
| 50 | real yy(0:nxmax-1,0:nymax-1,nzmax,3,maxnests) | |
| 51 | real ddx,ddy,rddx,rddy,dt1,dt2,y(2) | |
| 52 | real xt,yt,yint | |
| 53 | ||
| 54 | ||
| 55 | ||
| 56 | C If point at border of grid -> small displacement into grid | |
| 57 | ************************************************************ | |
| 58 | ||
| 59 | if (xt.ge.float(nxn(ngrid)-1)) xt=float(nxn(ngrid)-1)-0.00001 | |
| 60 | if (yt.ge.float(nyn(ngrid)-1)) yt=float(nyn(ngrid)-1)-0.00001 | |
| 61 | ||
| 62 | ||
| 63 | ||
| 64 | *********************************************************************** | |
| 65 | C 1.) Bilinear horizontal interpolation | |
| 66 | C This has to be done separately for 2 fields (Temporal) | |
| 67 | ******************************************************** | |
| 68 | ||
| 69 | C Determine the lower left corner and its distance to the current position | |
| 70 | ************************************************************************** | |
| 71 | ||
| 72 | ix=int(xt) | |
| 73 | jy=int(yt) | |
| 74 | ixp=ix+1 | |
| 75 | jyp=jy+1 | |
| 76 | ddx=xt-float(ix) | |
| 77 | ddy=yt-float(jy) | |
| 78 | rddx=1.-ddx | |
| 79 | rddy=1.-ddy | |
| 80 | ||
| 81 | ||
| 82 | C Loop over 2 time steps | |
| 83 | ************************ | |
| 84 | ||
| 85 | do 10 m=1,2 | |
| 86 | indexh=memind(index+m-1) | |
| 87 | ||
| 88 | 10 y(m)=rddx*rddy*yy(ix ,jy ,level,indexh,ngrid) | |
| 89 | + + ddx*rddy*yy(ixp,jy ,level,indexh,ngrid) | |
| 90 | + +rddx* ddy*yy(ix ,jyp,level,indexh,ngrid) | |
| 91 | + + ddx* ddy*yy(ixp,jyp,level,indexh,ngrid) | |
| 92 | ||
| 93 | ||
| 94 | ************************************* | |
| 95 | C 2.) Temporal interpolation (linear) | |
| 96 | ************************************* | |
| 97 | ||
| 98 | dt1=float(itime-itime1) | |
| 99 | dt2=float(itime2-itime) | |
| 100 | ||
| 101 | yint=(y(1)*dt2+y(2)*dt1)/(dt1+dt2) | |
| 102 | ||
| 103 | ||
| 104 | return | |
| 105 | end |
| 0 | subroutine lininterpol(yy,nxmax,nymax,nzmax,nx,ny,nz,memind, | |
| 1 | +height,xt,yt,zt,itime1,itime2,itime,indexf,yint) | |
| 2 | C i i i i i i i i | |
| 3 | C i i i i i i i i o | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of 3-dimensional meteorological fields. * | |
| 7 | * In horizontal direction bilinear interpolation interpolation is used. * | |
| 8 | * In the vertical and temporally a linear interpolation is used. * | |
| 9 | * * | |
| 10 | * 1,1 is the level below current position for the first time * | |
| 11 | * 1,2 is the level above current position for the first time * | |
| 12 | * 2,1 is the level below current position for the second time * | |
| 13 | * 2,2 is the level above current position for the second time * | |
| 14 | * * | |
| 15 | * * | |
| 16 | * Author: A. Stohl * | |
| 17 | * * | |
| 18 | * 30 May 1994 * | |
| 19 | * * | |
| 20 | ***************************************************************************** | |
| 21 | * * | |
| 22 | * Variables: * | |
| 23 | * * | |
| 24 | * dt1,dt2 time differences between fields and current position * | |
| 25 | * dz1,dz2 z distance between levels and current position * | |
| 26 | * height(nzmax) heights of the model levels * | |
| 27 | * indexf indicates the number of the wind field to be read in * | |
| 28 | * indexfh help variable * | |
| 29 | * indz the level closest to the current trajectory position * | |
| 30 | * indzh help variable * | |
| 31 | * itime current time * | |
| 32 | * itime1 time of the first wind field * | |
| 33 | * itime2 time of the second wind field * | |
| 34 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 35 | * memind(3) points to the places of the wind fields * | |
| 36 | * nx,ny,nz actual field dimensions in x,y and z direction * | |
| 37 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 38 | * xt current x coordinate * | |
| 39 | * yint the final interpolated value * | |
| 40 | * yt current y coordinate * | |
| 41 | * yy(0:nxmax-1,0:nymax-1,nzmax,3)meteorological field used for interpolation* | |
| 42 | * zt current z coordinate * | |
| 43 | * * | |
| 44 | ***************************************************************************** | |
| 45 | ||
| 46 | implicit none | |
| 47 | ||
| 48 | integer nx,ny,nz,nxmax,nymax,nzmax,memind(3),i,m,n,ix,jy,ixp,jyp | |
| 49 | integer itime,itime1,itime2,indexf,indz,indexfh,indzh | |
| 50 | real yy(0:nxmax-1,0:nymax-1,nzmax,3),height(nzmax) | |
| 51 | real ddx,ddy,rddx,rddy,dz1,dz2,dt1,dt2,y(2),yh(2) | |
| 52 | real xt,yt,zt,yint | |
| 53 | ||
| 54 | ||
| 55 | C Determine the level below the current position | |
| 56 | ************************************************ | |
| 57 | ||
| 58 | do 5 i=1,nz-1 | |
| 59 | if ((height(i).le.zt).and.(height(i+1).ge.zt)) then | |
| 60 | indz=i | |
| 61 | goto 6 | |
| 62 | endif | |
| 63 | 5 continue | |
| 64 | 6 continue | |
| 65 | ||
| 66 | ||
| 67 | C If point at border of grid -> small displacement into grid | |
| 68 | ************************************************************ | |
| 69 | ||
| 70 | if (xt.ge.float(nx-1)) xt=float(nx-1)-0.00001 | |
| 71 | if (yt.ge.float(ny-1)) yt=float(ny-1)-0.00001 | |
| 72 | ||
| 73 | ||
| 74 | ||
| 75 | *********************************************************************** | |
| 76 | C 1.) Bilinear horizontal interpolation | |
| 77 | C This has to be done separately for 6 fields (Temporal(2)*Vertical(3)) | |
| 78 | *********************************************************************** | |
| 79 | ||
| 80 | C Determine the lower left corner and its distance to the current position | |
| 81 | ************************************************************************** | |
| 82 | ||
| 83 | ix=int(xt) | |
| 84 | jy=int(yt) | |
| 85 | ixp=ix+1 | |
| 86 | jyp=jy+1 | |
| 87 | ddx=xt-float(ix) | |
| 88 | ddy=yt-float(jy) | |
| 89 | rddx=1.-ddx | |
| 90 | rddy=1.-ddy | |
| 91 | ||
| 92 | ||
| 93 | C Vertical distance to the level below and above current position | |
| 94 | ***************************************************************** | |
| 95 | ||
| 96 | dz1=zt-height(indz) | |
| 97 | dz2=height(indz+1)-zt | |
| 98 | ||
| 99 | ||
| 100 | C Loop over 2 time steps and 2 levels | |
| 101 | ************************************* | |
| 102 | ||
| 103 | do 10 m=1,2 | |
| 104 | indexfh=memind(indexf+m-1) | |
| 105 | do 20 n=1,2 | |
| 106 | indzh=indz+n-1 | |
| 107 | ||
| 108 | 20 y(n)=rddx*rddy*yy(ix ,jy ,indzh,indexfh) | |
| 109 | + + ddx*rddy*yy(ixp,jy ,indzh,indexfh) | |
| 110 | + +rddx* ddy*yy(ix ,jyp,indzh,indexfh) | |
| 111 | + + ddx* ddy*yy(ixp,jyp,indzh,indexfh) | |
| 112 | ||
| 113 | ||
| 114 | ||
| 115 | *********************************** | |
| 116 | C 2.) Linear vertical interpolation | |
| 117 | *********************************** | |
| 118 | ||
| 119 | 10 yh(m)=(dz2*y(1)+dz1*y(2))/(dz1+dz2) | |
| 120 | ||
| 121 | ||
| 122 | ||
| 123 | ************************************* | |
| 124 | C 3.) Temporal interpolation (linear) | |
| 125 | ************************************* | |
| 126 | ||
| 127 | dt1=float(itime-itime1) | |
| 128 | dt2=float(itime2-itime) | |
| 129 | ||
| 130 | yint=(yh(1)*dt2+yh(2)*dt1)/(dt1+dt2) | |
| 131 | ||
| 132 | ||
| 133 | return | |
| 134 | end |
| 0 | subroutine lininterpoln(yy,maxnests,nxmax,nymax,nzmax,ngrid, | |
| 1 | +nxn,nyn,nz,memind,height,xt,yt,zt,itime1,itime2,itime,indexf,yint) | |
| 2 | C i i i i i i | |
| 3 | C i i i i i i i i i i i i o | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of nested 3-dimensional meteorological fields. * | |
| 7 | * In horizontal direction bilinear interpolation interpolation is used. * | |
| 8 | * In the vertical and temporally a linear interpolation is used. * | |
| 9 | * * | |
| 10 | * 1,1 is the level below current position for the first time * | |
| 11 | * 1,2 is the level above current position for the first time * | |
| 12 | * 2,1 is the level below current position for the second time * | |
| 13 | * 2,2 is the level above current position for the second time * | |
| 14 | * * | |
| 15 | * * | |
| 16 | * Author: A. Stohl * | |
| 17 | * * | |
| 18 | * (30 May 1994) 9 January 1999 * | |
| 19 | * * | |
| 20 | ***************************************************************************** | |
| 21 | * * | |
| 22 | * Variables: * | |
| 23 | * * | |
| 24 | * dt1,dt2 time differences between fields and current position * | |
| 25 | * dz1,dz2 z distance between levels and current position * | |
| 26 | * height(nzmax) heights of the model levels * | |
| 27 | * indexf indicates the number of the wind field to be read in * | |
| 28 | * indexfh help variable * | |
| 29 | * indz the level closest to the current trajectory position * | |
| 30 | * indzh help variable * | |
| 31 | * itime current time * | |
| 32 | * itime1 time of the first wind field * | |
| 33 | * itime2 time of the second wind field * | |
| 34 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 35 | * maxnests maximum allowed number of nests * | |
| 36 | * memind(3) points to the places of the wind fields * | |
| 37 | * ngrid currently used number of nests * | |
| 38 | * nxn,nyn,nz actual field dimensions in x,y and z direction * | |
| 39 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 40 | * xt current x coordinate * | |
| 41 | * yint the final interpolated value * | |
| 42 | * yt current y coordinate * | |
| 43 | * yy(0:nxmax-1,0:nymax-1,nzmax,3)meteorological field used for interpolation* | |
| 44 | * zt current z coordinate * | |
| 45 | * * | |
| 46 | ***************************************************************************** | |
| 47 | ||
| 48 | implicit none | |
| 49 | ||
| 50 | integer maxnests,nxn(maxnests),nyn(maxnests),nz,nxmax,nymax,nzmax | |
| 51 | integer ngrid,memind(3),i,m,n,ix,jy,ixp,jyp | |
| 52 | integer itime,itime1,itime2,indexf,indz,indexfh,indzh | |
| 53 | real yy(0:nxmax-1,0:nymax-1,nzmax,3,maxnests),height(nzmax) | |
| 54 | real ddx,ddy,rddx,rddy,dz1,dz2,dt1,dt2,y(2),yh(2) | |
| 55 | real xt,yt,zt,yint | |
| 56 | ||
| 57 | ||
| 58 | C Determine the level below the current position | |
| 59 | ************************************************ | |
| 60 | ||
| 61 | do 5 i=1,nz-1 | |
| 62 | if ((height(i).le.zt).and.(height(i+1).ge.zt)) then | |
| 63 | indz=i | |
| 64 | goto 6 | |
| 65 | endif | |
| 66 | 5 continue | |
| 67 | 6 continue | |
| 68 | ||
| 69 | ||
| 70 | C If point at border of grid -> small displacement into grid | |
| 71 | ************************************************************ | |
| 72 | ||
| 73 | if (xt.ge.float(nxn(ngrid)-1)) xt=float(nxn(ngrid)-1)-0.00001 | |
| 74 | if (yt.ge.float(nyn(ngrid)-1)) yt=float(nyn(ngrid)-1)-0.00001 | |
| 75 | ||
| 76 | ||
| 77 | ||
| 78 | *********************************************************************** | |
| 79 | C 1.) Bilinear horizontal interpolation | |
| 80 | C This has to be done separately for 6 fields (Temporal(2)*Vertical(3)) | |
| 81 | *********************************************************************** | |
| 82 | ||
| 83 | C Determine the lower left corner and its distance to the current position | |
| 84 | ************************************************************************** | |
| 85 | ||
| 86 | ix=int(xt) | |
| 87 | jy=int(yt) | |
| 88 | ixp=ix+1 | |
| 89 | jyp=jy+1 | |
| 90 | ddx=xt-float(ix) | |
| 91 | ddy=yt-float(jy) | |
| 92 | rddx=1.-ddx | |
| 93 | rddy=1.-ddy | |
| 94 | ||
| 95 | ||
| 96 | C Vertical distance to the level below and above current position | |
| 97 | ***************************************************************** | |
| 98 | ||
| 99 | dz1=zt-height(indz) | |
| 100 | dz2=height(indz+1)-zt | |
| 101 | ||
| 102 | ||
| 103 | C Loop over 2 time steps and 2 levels | |
| 104 | ************************************* | |
| 105 | ||
| 106 | do 10 m=1,2 | |
| 107 | indexfh=memind(indexf+m-1) | |
| 108 | do 20 n=1,2 | |
| 109 | indzh=indz+n-1 | |
| 110 | ||
| 111 | 20 y(n)=rddx*rddy*yy(ix ,jy ,indzh,indexfh,ngrid) | |
| 112 | + + ddx*rddy*yy(ixp,jy ,indzh,indexfh,ngrid) | |
| 113 | + +rddx* ddy*yy(ix ,jyp,indzh,indexfh,ngrid) | |
| 114 | + + ddx* ddy*yy(ixp,jyp,indzh,indexfh,ngrid) | |
| 115 | ||
| 116 | ||
| 117 | ||
| 118 | *********************************** | |
| 119 | C 2.) Linear vertical interpolation | |
| 120 | *********************************** | |
| 121 | ||
| 122 | 10 yh(m)=(dz2*y(1)+dz1*y(2))/(dz1+dz2) | |
| 123 | ||
| 124 | ||
| 125 | ||
| 126 | ************************************* | |
| 127 | C 3.) Temporal interpolation (linear) | |
| 128 | ************************************* | |
| 129 | ||
| 130 | dt1=float(itime-itime1) | |
| 131 | dt2=float(itime2-itime) | |
| 132 | ||
| 133 | yint=(yh(1)*dt2+yh(2)*dt1)/(dt1+dt2) | |
| 134 | ||
| 135 | ||
| 136 | return | |
| 137 | end |
| 0 | SHELL = /bin/bash | |
| 1 | MAIN = FLEXTRA_ECMWF | |
| 2 | INCF = incl* | |
| 3 | # | |
| 4 | ||
| 5 | INCPATH = /nilu2/home/flexpart/lib64/absoft/include | |
| 6 | LIBPATH1 = /nilu2/home/flexpart/lib64/absoft/lib | |
| 7 | LIBPATH2 = /nilu2/home/flexpart/lib64/absoft/lib | |
| 8 | FFLAGS = -O2 -s -I$(INCPATH) -p$(INCPATH) -m64 -mcmodel=medium | |
| 9 | #FFLAGS = -g -Rb -Rc -Rs -s -I$(INCPATH) -p$(INCPATH) -m64 -mcmodel=medium | |
| 10 | LDFLAGS = $(FFLAGS) -L$(LIBPATH2) -L$(LIBPATH1) -lgrib_api_f90 -lgrib_api -lm -ljasper | |
| 11 | # | |
| 12 | ||
| 13 | OBJECTS = caldate.o openoutput.o \ | |
| 14 | checklimits.o coordtrafo.o \ | |
| 15 | orolininterpol.o etatrafo.o \ | |
| 16 | petters.o eta.ecmwf.o FLEXTRA.o \ | |
| 17 | pp.ecmwf.o geteta.o \ | |
| 18 | getfields.o pvinterpol.o \ | |
| 19 | getheight.o random.o \ | |
| 20 | readavailable.o getwind.o \ | |
| 21 | readcommand.o gridcheck.o \ | |
| 22 | inter3d.o readoro.o \ | |
| 23 | interisentrop.o readpaths.o \ | |
| 24 | interisobar.o readpoints.o \ | |
| 25 | intermix.o readwind.o \ | |
| 26 | intermod.o subtractoro.o \ | |
| 27 | interpol.o timemanager.o \ | |
| 28 | juldate.o trajinterpol.o \ | |
| 29 | lamphi_ecmwf.o trajout.o \ | |
| 30 | lastprocessor.o uncertcoor.o \ | |
| 31 | levinterpol.o utransform.o \ | |
| 32 | levlininterpol.o vtransform.o \ | |
| 33 | lininterpol.o wtransform.o \ | |
| 34 | numerical.o zztrafo.o \ | |
| 35 | cmapf1.0.o gridcheck_nests.o \ | |
| 36 | readwind_nests.o lininterpol_nests.o \ | |
| 37 | levlininterpol_nests.o orolininterpol_nests.o \ | |
| 38 | interpol_nests.o levinterpol_nests.o \ | |
| 39 | skplin.o readcet.o \ | |
| 40 | opencetoutput.o openflightoutput.o \ | |
| 41 | readflight.o calcpv.o \ | |
| 42 | getmet.o calcpv_nests.o \ | |
| 43 | swap32.o ew.o | |
| 44 | ||
| 45 | ||
| 46 | $(MAIN): $(OBJECTS) | |
| 47 | $(FC) *.o -o $(MAIN) $(LDFLAGS) | |
| 48 | $(OBJECTS): $(INCF) | |
| 49 |
| 0 | SHELL = /bin/bash | |
| 1 | MAIN = FLEXTRA_GFS | |
| 2 | INCF = incl* | |
| 3 | # | |
| 4 | ||
| 5 | FC = /opt/absoft/bin/f95 | |
| 6 | INCPATH = /nilu/home/flexpart/lib/grib_api/include | |
| 7 | LIBPATH1 = /nilu/home/flexpart/lib/grib_api/lib | |
| 8 | LIBPATH2 = /nilu/home/flexpart/lib/jasper/lib | |
| 9 | #FFLAGS = -s -B108 -YEXT_NAMES=LCS -I$(INCPATH) | |
| 10 | FFLAGS = -g -Rb -Rc -Rs -s -B108 -YEXT_NAMES=LCS -I$(INCPATH) -p$(INCPATH) | |
| 11 | LDFLAGS = $(FFLAGS) -L$(LIBPATH1) -L$(LIBPATH2) -lgrib_api_f77 -lgrib_api -lm -ljasper | |
| 12 | # | |
| 13 | ||
| 14 | OBJECTS = caldate.o openoutput.o \ | |
| 15 | checklimits.o coordtrafo.o \ | |
| 16 | orolininterpol.o etatrafo.o \ | |
| 17 | petters.o eta.ecmwf.o FLEXTRA.o \ | |
| 18 | pp.ecmwf.o geteta.o \ | |
| 19 | getfields.o pvinterpol.o \ | |
| 20 | getheight.o random.o \ | |
| 21 | readavailable.o getwind.o \ | |
| 22 | readcommand.o gridcheck_gfs.o \ | |
| 23 | inter3d.o readoro.o \ | |
| 24 | interisentrop.o readpaths.o \ | |
| 25 | interisobar.o readpoints.o \ | |
| 26 | intermix.o readwind_gfs.o \ | |
| 27 | intermod.o subtractoro.o \ | |
| 28 | interpol.o timemanager.o \ | |
| 29 | juldate.o trajinterpol.o \ | |
| 30 | lamphi_ecmwf.o trajout.o \ | |
| 31 | lastprocessor.o uncertcoor.o \ | |
| 32 | levinterpol.o utransform.o \ | |
| 33 | levlininterpol.o vtransform.o \ | |
| 34 | lininterpol.o wtransform.o \ | |
| 35 | numerical.o zztrafo.o \ | |
| 36 | cmapf1.0.o gridcheck_nests_gfs.o \ | |
| 37 | readwind_nests_gfs.o lininterpol_nests.o \ | |
| 38 | levlininterpol_nests.o orolininterpol_nests.o \ | |
| 39 | interpol_nests.o levinterpol_nests.o \ | |
| 40 | skplin.o readcet.o \ | |
| 41 | opencetoutput.o openflightoutput.o \ | |
| 42 | readflight.o calcpv.o \ | |
| 43 | getmet.o calcpv_nests.o \ | |
| 44 | swap32.o ew_gfs.o | |
| 45 | ||
| 46 | ||
| 47 | $(MAIN): $(OBJECTS) | |
| 48 | $(FC) *.o -o $(MAIN) $(LDFLAGS) | |
| 49 | $(OBJECTS): $(INCF) | |
| 50 |
| 0 | C THESE ROUTINES HAVE BEEN TAKEN FROM PRESS ET AL. (1992): NUMERICAL RECIPES | |
| 1 | C HOWEVER, THEY HAVE BEEN MODIFIED FOR PERFORMANCE REASONS. | |
| 2 | C A. Stohl, 31 May 1994 | |
| 3 | ||
| 4 | ||
| 5 | SUBROUTINE BICUBIC(Y,Y1,Y2,Y12,X1L,X1U,X2L,X2U,X1,X2,ANSY,LD1,LD2) | |
| 6 | DIMENSION Y(4,LD1,LD2),Y1(4,LD1,LD2),Y2(4,LD1,LD2),Y12(4,LD1,LD2) | |
| 7 | DIMENSION C(4,4,2,3),ANSY(LD1,LD2) | |
| 8 | CALL BCUCOF(Y,Y1,Y2,Y12,X1U-X1L,X2U-X2L,C,LD1,LD2) | |
| 9 | T=(X1-X1L)/(X1U-X1L) | |
| 10 | U=(X2-X2L)/(X2U-X2L) | |
| 11 | DO 11 M=1,LD1 | |
| 12 | DO 11 N=1,LD2 | |
| 13 | ANSY(M,N)=0. | |
| 14 | DO 11 I=4,1,-1 | |
| 15 | 11 ANSY(M,N)=T*ANSY(M,N)+((C(I,4,M,N)*U+C(I,3,M,N))*U+ | |
| 16 | + C(I,2,M,N))*U+C(I,1,M,N) | |
| 17 | RETURN | |
| 18 | END | |
| 19 | ||
| 20 | ||
| 21 | SUBROUTINE BCUCOF(Y,Y1,Y2,Y12,D1,D2,C,LD1,LD2) | |
| 22 | DIMENSION C(4,4,2,3),Y(4,LD1,LD2),Y1(4,LD1,LD2) | |
| 23 | DIMENSION Y2(4,LD1,LD2),Y12(4,LD1,LD2) | |
| 24 | DIMENSION CL(16),X(16),WT(16,16) | |
| 25 | SAVE WT | |
| 26 | DATA WT/1.,0.,-3.,2.,4*0.,-3.,0.,9.,-6.,2.,0.,-6., | |
| 27 | * 4.,8*0.,3.,0.,-9.,6.,-2.,0.,6.,-4.,10*0.,9.,-6., | |
| 28 | * 2*0.,-6.,4.,2*0.,3.,-2.,6*0.,-9.,6.,2*0.,6.,-4., | |
| 29 | * 4*0.,1.,0.,-3.,2.,-2.,0.,6.,-4.,1.,0.,-3.,2.,8*0., | |
| 30 | * -1.,0.,3.,-2.,1.,0.,-3.,2.,10*0.,-3.,2.,2*0.,3., | |
| 31 | * -2.,6*0.,3.,-2.,2*0.,-6.,4.,2*0.,3.,-2.,0.,1.,-2., | |
| 32 | * 1.,5*0.,-3.,6.,-3.,0.,2.,-4.,2.,9*0.,3.,-6.,3.,0., | |
| 33 | * -2.,4.,-2.,10*0.,-3.,3.,2*0.,2.,-2.,2*0.,-1.,1., | |
| 34 | * 6*0.,3.,-3.,2*0.,-2.,2.,5*0.,1.,-2.,1.,0.,-2.,4., | |
| 35 | * -2.,0.,1.,-2.,1.,9*0.,-1.,2.,-1.,0.,1.,-2.,1.,10*0., | |
| 36 | * 1.,-1.,2*0.,-1.,1.,6*0.,-1.,1.,2*0.,2.,-2.,2*0.,-1.,1./ | |
| 37 | D1D2=D1*D2 | |
| 38 | DO 15 M=1,LD1 | |
| 39 | DO 15 N=1,LD2 | |
| 40 | DO 11 I=1,4 | |
| 41 | X(I)=Y(I,M,N) | |
| 42 | X(I+4)=Y1(I,M,N)*D1 | |
| 43 | X(I+8)=Y2(I,M,N)*D2 | |
| 44 | 11 X(I+12)=Y12(I,M,N)*D1D2 | |
| 45 | DO 13 I=1,16 | |
| 46 | XX=0. | |
| 47 | DO 12 K=1,16 | |
| 48 | 12 XX=XX+WT(I,K)*X(K) | |
| 49 | 13 CL(I)=XX | |
| 50 | L=0 | |
| 51 | DO 15 I=1,4 | |
| 52 | DO 15 J=1,4 | |
| 53 | L=L+1 | |
| 54 | 15 C(I,J,M,N)=CL(L) | |
| 55 | RETURN | |
| 56 | END | |
| 57 | ||
| 58 | ||
| 59 | ||
| 60 | ||
| 61 | SUBROUTINE POLYNOM(XA,YA,N,X,Y,LD) | |
| 62 | PARAMETER (NMAX=10) | |
| 63 | DIMENSION XA(N),YA(LD,N),C(2,NMAX),D(2,NMAX),Y(LD) | |
| 64 | NSS=1 | |
| 65 | DIF=ABS(X-XA(1)) | |
| 66 | DO 11 I=1,N | |
| 67 | DIFT=ABS(X-XA(I)) | |
| 68 | IF (DIFT.LT.DIF) THEN | |
| 69 | NSS=I | |
| 70 | DIF=DIFT | |
| 71 | ENDIF | |
| 72 | DO 11 MM=1,LD | |
| 73 | C(MM,I)=YA(MM,I) | |
| 74 | 11 D(MM,I)=YA(MM,I) | |
| 75 | ||
| 76 | DO 13 MM=1,LD | |
| 77 | NS=NSS | |
| 78 | Y(MM)=YA(MM,NS) | |
| 79 | NS=NS-1 | |
| 80 | DO 13 M=1,N-1 | |
| 81 | DO 12 I=1,N-M | |
| 82 | HO=XA(I)-X | |
| 83 | HP=XA(I+M)-X | |
| 84 | W=C(MM,I+1)-D(MM,I) | |
| 85 | DEN=HO-HP | |
| 86 | DEN=W/DEN | |
| 87 | D(MM,I)=HP*DEN | |
| 88 | C(MM,I)=HO*DEN | |
| 89 | 12 CONTINUE | |
| 90 | IF (2*NS.LT.N-M)THEN | |
| 91 | DY=C(MM,NS+1) | |
| 92 | ELSE | |
| 93 | DY=D(MM,NS) | |
| 94 | NS=NS-1 | |
| 95 | ENDIF | |
| 96 | Y(MM)=Y(MM)+DY | |
| 97 | 13 CONTINUE | |
| 98 | RETURN | |
| 99 | END |
| 0 | subroutine opencetoutput(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine opens the trajectory data output files. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 16 February 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * compoint(maxpoint) comment for each startpoint * | |
| 14 | * datestring date and time of model run * | |
| 15 | * error .true., if error ocurred in subprogram, else .false. * | |
| 16 | * numpoint number of starting points * | |
| 17 | * * | |
| 18 | * Constants: * | |
| 19 | * unittraj unittraj+i are connected to trajectory output (point i) * | |
| 20 | * unittraji unittraji+i are connected to interpolated trajectories * | |
| 21 | * * | |
| 22 | ******************************************************************************** | |
| 23 | ||
| 24 | include 'includepar' | |
| 25 | include 'includecom' | |
| 26 | ||
| 27 | integer k,l | |
| 28 | logical error | |
| 29 | character datestring*24 | |
| 30 | ||
| 31 | ||
| 32 | error=.false. | |
| 33 | ||
| 34 | ||
| 35 | C Look for runtime | |
| 36 | ****************** | |
| 37 | ||
| 38 | C call fdate(datestring) | |
| 39 | ||
| 40 | ||
| 41 | C If possible, use the first 20 characters of the comment for the file | |
| 42 | C name identification. | |
| 43 | ********************************************************************* | |
| 44 | ||
| 45 | C 1. if wanted, original trajectories (flexible time step) | |
| 46 | ********************************************************** | |
| 47 | ||
| 48 | if ((inter.eq.0).or.(inter.eq.2)) then | |
| 49 | k=index(compoint(1),' ')-1 | |
| 50 | k=min(k,20) | |
| 51 | open(unittraj,file=path(2)(1:len(2))//'CET_'//compoint(1) | |
| 52 | + (1:k),status='new',err=998) | |
| 53 | write(unittraj,'(i8,a)') 42+4*numbnests, | |
| 54 | + ' Number of header lines' | |
| 55 | write(unittraj,'(a69)') '************************************* | |
| 56 | +********************************' | |
| 57 | write(unittraj,'(a69)') '* | |
| 58 | + *' | |
| 59 | write(unittraj,'(a69)') '* FLEXTRA V4.0 MODEL O | |
| 60 | +UTPUT *' | |
| 61 | write(unittraj,'(a69)') '* FOR ECMWF WINDF | |
| 62 | +IELDS *' | |
| 63 | write(unittraj,'(a69)') '* | |
| 64 | + *' | |
| 65 | write(unittraj,'(a69)') '************************************* | |
| 66 | +********************************' | |
| 67 | write(unittraj,'(a69)') '* | |
| 68 | + *' | |
| 69 | write(unittraj,'(a,a,a)') '* TIME OF COMPUTATION: | |
| 70 | + ' ,datestring(1:24),' *' | |
| 71 | write(unittraj,'(a69)') '* | |
| 72 | + *' | |
| 73 | write(unittraj,'(a69)') '************************************* | |
| 74 | +********************************' | |
| 75 | write(unittraj,'(a69)') '* | |
| 76 | + *' | |
| 77 | if (kind(1).eq.1) then | |
| 78 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: 3- | |
| 79 | +DIMENSIONAL *' | |
| 80 | else if (kind(1).eq.2) then | |
| 81 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: ON | |
| 82 | + MODEL LAYERS *' | |
| 83 | else if (kind(1).eq.4) then | |
| 84 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 85 | +OBARIC *' | |
| 86 | else if (kind(1).eq.5) then | |
| 87 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 88 | +ENTROPIC *' | |
| 89 | endif | |
| 90 | write(unittraj,'(a69)') '* | |
| 91 | + *' | |
| 92 | write(unittraj,'(a69)') '************************************* | |
| 93 | +********************************' | |
| 94 | write(unittraj,'(a69)') '* | |
| 95 | + *' | |
| 96 | write(unittraj,'(a69)') '* INTEGRATION SCHEME: PE | |
| 97 | +TTERSSEN *' | |
| 98 | if (inpolkind.eq.1) then | |
| 99 | write(unittraj,'(a69)') '* INTERPOLATION METHOD: ID | |
| 100 | +EAL *' | |
| 101 | else | |
| 102 | write(unittraj,'(a69)') '* INTERPOLATION METHOD: LI | |
| 103 | +NEAR *' | |
| 104 | endif | |
| 105 | write(unittraj,'(a69)') '* | |
| 106 | + *' | |
| 107 | write(unittraj,'(a,f5.2,a)') '* SPATIAL CFL CRITERION | |
| 108 | +: ',cfl,' *' | |
| 109 | write(unittraj,'(a,f5.2,a)') '* TEMPORAL CFL CRITERION | |
| 110 | +: ',cflt,' *' | |
| 111 | write(unittraj,'(a69)') '* | |
| 112 | + *' | |
| 113 | write(unittraj,'(a69)') '************************************* | |
| 114 | +********************************' | |
| 115 | write(unittraj,'(a69)') '* | |
| 116 | + *' | |
| 117 | write(unittraj,'(a)') '* START POINT COMMENT: '// | |
| 118 | + compoint(1)(1:40)//' *' | |
| 119 | write(unittraj,'(a)') '* MODEL RUN COMMENT: '// | |
| 120 | + runcomment(1:47)//'*' | |
| 121 | write(unittraj,'(a69)') '* | |
| 122 | + *' | |
| 123 | write(unittraj,'(a69)') '************************************* | |
| 124 | +********************************' | |
| 125 | write(unittraj,'(a69)') '* | |
| 126 | + *' | |
| 127 | write(unittraj,'(a69)') '* INFORMATION ON WIND FIELDS USED FOR | |
| 128 | + COMPUTATIONS: *' | |
| 129 | write(unittraj,'(a69)') '* | |
| 130 | + *' | |
| 131 | write(unittraj,'(a,i6,a)') '* NORMAL INTERVAL BETWEEN WIND FIE | |
| 132 | +LDS: ',idiffnorm,' SECONDS *' | |
| 133 | write(unittraj,'(a,i6,a)') '* MAXIMUM INTERVAL BETWEEN WIND FI | |
| 134 | +ELDS: ',idiffmax,' SECONDS *' | |
| 135 | write(unittraj,'(a69)') '* | |
| 136 | + *' | |
| 137 | write(unittraj,'(a29,2i4,a32)') '* NUMBER OF VERTICAL LEVELS: | |
| 138 | + ',nuvz,nwz,' *' | |
| 139 | write(unittraj,'(a69)') '* | |
| 140 | + *' | |
| 141 | write(unittraj,'(a69)') '* MOTHER DOMAIN: | |
| 142 | + *' | |
| 143 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 144 | + '* LONGITUDE RANGE: ',xlon0, ' TO ',xlon0+(nx-1)*dx, | |
| 145 | + ' GRID DISTANCE: ',dx,' *' | |
| 146 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 147 | + '* LATITUDE RANGE: ',ylat0, ' TO ',ylat0+(ny-1)*dy, | |
| 148 | + ' GRID DISTANCE: ',dy,' *' | |
| 149 | ||
| 150 | do 300 l=1,numbnests | |
| 151 | write(unittraj,'(a69)') '* | |
| 152 | + *' | |
| 153 | write(unittraj,'(a,i2,a)') '* NESTED DOMAIN NUMBER: ',l,' | |
| 154 | + *' | |
| 155 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 156 | + '* LONGITUDE RANGE: ',xlon0n(l), ' TO ', | |
| 157 | + xlon0n(l)+(nxn(l)-1)*dxn(l), | |
| 158 | + ' GRID DISTANCE: ',dxn(l),' *' | |
| 159 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 160 | + '* LATITUDE RANGE: ',ylat0n(l), ' TO ', | |
| 161 | + ylat0n(l)+(nyn(l)-1)*dyn(l), | |
| 162 | + ' GRID DISTANCE: ',dyn(l),' *' | |
| 163 | 300 continue | |
| 164 | ||
| 165 | write(unittraj,'(a69)') '* | |
| 166 | + *' | |
| 167 | write(unittraj,'(a69)') '************************************* | |
| 168 | +********************************' | |
| 169 | ||
| 170 | write(unittraj,*) | |
| 171 | endif | |
| 172 | ||
| 173 | ||
| 174 | C 2. if wanted, interpolated trajectories (constant time step) | |
| 175 | ************************************************************** | |
| 176 | ||
| 177 | if (inter.ge.1) then | |
| 178 | k=index(compoint(1),' ')-1 | |
| 179 | k=min(k,20) | |
| 180 | open(unittraji,file=path(2)(1:len(2))//'CETI_'//compoint(1) | |
| 181 | + (1:k),status='new',err=999) | |
| 182 | write(unittraji,'(i8,a)') 42+4*numbnests, | |
| 183 | + ' Number of header lines' | |
| 184 | write(unittraji,'(a69)') '************************************* | |
| 185 | +********************************' | |
| 186 | write(unittraji,'(a69)') '* | |
| 187 | + *' | |
| 188 | write(unittraji,'(a69)') '* FLEXTRA MODEL O | |
| 189 | +UTPUT *' | |
| 190 | write(unittraji,'(a69)') '* FOR ECMWF WINDF | |
| 191 | +IELDS *' | |
| 192 | write(unittraji,'(a69)') '* | |
| 193 | + *' | |
| 194 | write(unittraji,'(a69)') '************************************* | |
| 195 | +********************************' | |
| 196 | write(unittraji,'(a69)') '* | |
| 197 | + *' | |
| 198 | write(unittraji,'(a,a,a)') '* TIME OF COMPUTATION: | |
| 199 | + ',datestring(1:24),' *' | |
| 200 | write(unittraji,'(a69)') '* | |
| 201 | + *' | |
| 202 | write(unittraji,'(a69)') '************************************* | |
| 203 | +********************************' | |
| 204 | write(unittraji,'(a69)') '* | |
| 205 | + *' | |
| 206 | if (kind(1).eq.1) then | |
| 207 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: 3- | |
| 208 | +DIMENSIONAL *' | |
| 209 | else if (kind(1).eq.2) then | |
| 210 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: ON | |
| 211 | + MODEL LAYERS *' | |
| 212 | else if (kind(1).eq.4) then | |
| 213 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 214 | +OBARIC *' | |
| 215 | else if (kind(1).eq.5) then | |
| 216 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 217 | +ENTROPIC *' | |
| 218 | endif | |
| 219 | write(unittraji,'(a69)') '* | |
| 220 | + *' | |
| 221 | write(unittraji,'(a69)') '************************************* | |
| 222 | +********************************' | |
| 223 | write(unittraji,'(a69)') '* | |
| 224 | + *' | |
| 225 | write(unittraji,'(a69)') '* INTEGRATION SCHEME: PE | |
| 226 | +TTERSSEN *' | |
| 227 | if (inpolkind.eq.1) then | |
| 228 | write(unittraji,'(a69)') '* INTERPOLATION METHOD: ID | |
| 229 | +EAL *' | |
| 230 | else | |
| 231 | write(unittraji,'(a69)') '* INTERPOLATION METHOD: LI | |
| 232 | +NEAR *' | |
| 233 | endif | |
| 234 | write(unittraji,'(a69)') '* | |
| 235 | + *' | |
| 236 | write(unittraji,'(a,f5.2,a)') '* SPATIAL CFL CRITERION | |
| 237 | +: ',cfl,' *' | |
| 238 | write(unittraji,'(a,f5.2,a)') '* TEMPORAL CFL CRITERION | |
| 239 | +: ',cflt,' *' | |
| 240 | write(unittraji,'(a69)') '* | |
| 241 | + *' | |
| 242 | write(unittraji,'(a69)') '************************************* | |
| 243 | +********************************' | |
| 244 | write(unittraji,'(a69)') '* | |
| 245 | + *' | |
| 246 | write(unittraji,'(a)') '* START POINT COMMENT: '// | |
| 247 | + compoint(1)(1:40)//' *' | |
| 248 | write(unittraji,'(a)') '* MODEL RUN COMMENT: '// | |
| 249 | + runcomment(1:47)//'*' | |
| 250 | write(unittraji,'(a69)') '* | |
| 251 | + *' | |
| 252 | write(unittraji,'(a69)') '************************************* | |
| 253 | +********************************' | |
| 254 | write(unittraji,'(a69)') '* | |
| 255 | + *' | |
| 256 | write(unittraji,'(a69)') '* INFORMATION ON WIND FIELDS USED FOR | |
| 257 | + COMPUTATIONS: *' | |
| 258 | write(unittraji,'(a69)') '* | |
| 259 | + *' | |
| 260 | write(unittraji,'(a,i6,a)') '* NORMAL INTERVAL BETWEEN WIND FIE | |
| 261 | +LDS: ',idiffnorm,' SECONDS *' | |
| 262 | write(unittraji,'(a,i6,a)') '* MAXIMUM INTERVAL BETWEEN WIND FI | |
| 263 | +ELDS: ',idiffmax,' SECONDS *' | |
| 264 | write(unittraji,'(a69)') '* | |
| 265 | + *' | |
| 266 | write(unittraji,'(a29,2i4,a32)') '* NUMBER OF VERTICAL LEVELS: | |
| 267 | + ',nuvz,nwz,' *' | |
| 268 | write(unittraji,'(a69)') '* | |
| 269 | + *' | |
| 270 | write(unittraji,'(a69)') '* MOTHER DOMAIN: | |
| 271 | + *' | |
| 272 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 273 | + '* LONGITUDE RANGE: ',xlon0, ' TO ',xlon0+(nx-1)*dx, | |
| 274 | + ' GRID DISTANCE: ',dx,' *' | |
| 275 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 276 | + '* LATITUDE RANGE: ',ylat0, ' TO ',ylat0+(ny-1)*dy, | |
| 277 | + ' GRID DISTANCE: ',dy,' *' | |
| 278 | ||
| 279 | do 400 l=1,numbnests | |
| 280 | write(unittraji,'(a69)') '* | |
| 281 | + *' | |
| 282 | write(unittraji,'(a,i2,a)') '* NESTED DOMAIN NUMBER: ',l,' | |
| 283 | + *' | |
| 284 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 285 | + '* LONGITUDE RANGE: ',xlon0n(l), ' TO ', | |
| 286 | + xlon0n(l)+(nxn(l)-1)*dxn(l), | |
| 287 | + ' GRID DISTANCE: ',dxn(l),' *' | |
| 288 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 289 | + '* LATITUDE RANGE: ',ylat0n(l), ' TO ', | |
| 290 | + ylat0n(l)+(nyn(l)-1)*dyn(l), | |
| 291 | + ' GRID DISTANCE: ',dyn(l),' *' | |
| 292 | 400 continue | |
| 293 | ||
| 294 | write(unittraji,'(a69)') '* | |
| 295 | + *' | |
| 296 | write(unittraji,'(a69)') '************************************* | |
| 297 | +********************************' | |
| 298 | write(unittraji,*) | |
| 299 | endif | |
| 300 | ||
| 301 | return | |
| 302 | ||
| 303 | 998 write(*,*) | |
| 304 | write(*,*) ' #### TRAJECTORY MODEL ERROR! THE FILE #### ' | |
| 305 | write(*,*) | |
| 306 | write(*,*) ' '//path(2)(1:len(2))//'CET_'//compoint(1)(1:k) | |
| 307 | write(*,*) | |
| 308 | write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### ' | |
| 309 | write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### ' | |
| 310 | write(*,*) ' #### THE PROGRAM AGAIN. #### ' | |
| 311 | error=.true. | |
| 312 | return | |
| 313 | ||
| 314 | 999 write(*,*) | |
| 315 | write(*,*) ' #### TRAJECTORY MODEL ERROR! THE FILE #### ' | |
| 316 | write(*,*) | |
| 317 | write(*,*) ' '//path(2)(1:len(2))//'CETI_'//compoint(1)(1:k) | |
| 318 | write(*,*) | |
| 319 | write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### ' | |
| 320 | write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### ' | |
| 321 | write(*,*) ' #### THE PROGRAM AGAIN. #### ' | |
| 322 | error=.true. | |
| 323 | ||
| 324 | return | |
| 325 | end |
| 0 | subroutine openflightoutput(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine opens the trajectory data output files. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 16 February 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * compoint(maxpoint) comment for each startpoint * | |
| 14 | * datestring date and time of model run * | |
| 15 | * error .true., if error ocurred in subprogram, else .false. * | |
| 16 | * numpoint number of starting points * | |
| 17 | * * | |
| 18 | * Constants: * | |
| 19 | * unittraj unittraj+i are connected to trajectory output (point i) * | |
| 20 | * unittraji unittraji+i are connected to interpolated trajectories * | |
| 21 | * * | |
| 22 | ******************************************************************************** | |
| 23 | ||
| 24 | include 'includepar' | |
| 25 | include 'includecom' | |
| 26 | ||
| 27 | integer k,l | |
| 28 | logical error | |
| 29 | character datestring*24 | |
| 30 | ||
| 31 | ||
| 32 | error=.false. | |
| 33 | ||
| 34 | ||
| 35 | C Look for runtime | |
| 36 | ****************** | |
| 37 | ||
| 38 | C call fdate(datestring) | |
| 39 | ||
| 40 | ||
| 41 | C If possible, use the first 20 characters of the comment for the file | |
| 42 | C name identification. | |
| 43 | ********************************************************************* | |
| 44 | ||
| 45 | C 1. if wanted, original trajectories (flexible time step) | |
| 46 | ********************************************************** | |
| 47 | ||
| 48 | if ((inter.eq.0).or.(inter.eq.2)) then | |
| 49 | k=index(compoint(1),' ')-1 | |
| 50 | k=min(k,20) | |
| 51 | open(unittraj,file=path(2)(1:len(2))//'FLIGHT_'//compoint(1) | |
| 52 | + (1:k),status='new',err=998) | |
| 53 | write(unittraj,'(i8,a)') 42+4*numbnests, | |
| 54 | + ' Number of header lines' | |
| 55 | write(unittraj,'(a69)') '************************************* | |
| 56 | +********************************' | |
| 57 | write(unittraj,'(a69)') '* | |
| 58 | + *' | |
| 59 | write(unittraj,'(a69)') '* FLEXTRA V4.0 MODEL O | |
| 60 | +UTPUT *' | |
| 61 | write(unittraj,'(a69)') '* FOR ECMWF WINDF | |
| 62 | +IELDS *' | |
| 63 | write(unittraj,'(a69)') '* | |
| 64 | + *' | |
| 65 | write(unittraj,'(a69)') '************************************* | |
| 66 | +********************************' | |
| 67 | write(unittraj,'(a69)') '* | |
| 68 | + *' | |
| 69 | write(unittraj,'(a,a,a)') '* TIME OF COMPUTATION: | |
| 70 | + ' ,datestring(1:24),' *' | |
| 71 | write(unittraj,'(a69)') '* | |
| 72 | + *' | |
| 73 | write(unittraj,'(a69)') '************************************* | |
| 74 | +********************************' | |
| 75 | write(unittraj,'(a69)') '* | |
| 76 | + *' | |
| 77 | if (kind(1).eq.1) then | |
| 78 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: 3- | |
| 79 | +DIMENSIONAL *' | |
| 80 | else if (kind(1).eq.2) then | |
| 81 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: ON | |
| 82 | + MODEL LAYERS *' | |
| 83 | else if (kind(1).eq.4) then | |
| 84 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 85 | +OBARIC *' | |
| 86 | else if (kind(1).eq.5) then | |
| 87 | write(unittraj,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 88 | +ENTROPIC *' | |
| 89 | endif | |
| 90 | write(unittraj,'(a69)') '* | |
| 91 | + *' | |
| 92 | write(unittraj,'(a69)') '************************************* | |
| 93 | +********************************' | |
| 94 | write(unittraj,'(a69)') '* | |
| 95 | + *' | |
| 96 | write(unittraj,'(a69)') '* INTEGRATION SCHEME: PE | |
| 97 | +TTERSSEN *' | |
| 98 | if (inpolkind.eq.1) then | |
| 99 | write(unittraj,'(a69)') '* INTERPOLATION METHOD: ID | |
| 100 | +EAL *' | |
| 101 | else | |
| 102 | write(unittraj,'(a69)') '* INTERPOLATION METHOD: LI | |
| 103 | +NEAR *' | |
| 104 | endif | |
| 105 | write(unittraj,'(a69)') '* | |
| 106 | + *' | |
| 107 | write(unittraj,'(a,f5.2,a)') '* SPATIAL CFL CRITERION | |
| 108 | +: ',cfl,' *' | |
| 109 | write(unittraj,'(a,f5.2,a)') '* TEMPORAL CFL CRITERION | |
| 110 | +: ',cflt,' *' | |
| 111 | write(unittraj,'(a69)') '* | |
| 112 | + *' | |
| 113 | write(unittraj,'(a69)') '************************************* | |
| 114 | +********************************' | |
| 115 | write(unittraj,'(a69)') '* | |
| 116 | + *' | |
| 117 | write(unittraj,'(a)') '* START POINT COMMENT: '// | |
| 118 | + compoint(1)(1:40)//' *' | |
| 119 | write(unittraj,'(a)') '* MODEL RUN COMMENT: '// | |
| 120 | + runcomment(1:47)//'*' | |
| 121 | write(unittraj,'(a69)') '* | |
| 122 | + *' | |
| 123 | write(unittraj,'(a69)') '************************************* | |
| 124 | +********************************' | |
| 125 | write(unittraj,'(a69)') '* | |
| 126 | + *' | |
| 127 | write(unittraj,'(a69)') '* INFORMATION ON WIND FIELDS USED FOR | |
| 128 | + COMPUTATIONS: *' | |
| 129 | write(unittraj,'(a69)') '* | |
| 130 | + *' | |
| 131 | write(unittraj,'(a,i6,a)') '* NORMAL INTERVAL BETWEEN WIND FIE | |
| 132 | +LDS: ',idiffnorm,' SECONDS *' | |
| 133 | write(unittraj,'(a,i6,a)') '* MAXIMUM INTERVAL BETWEEN WIND FI | |
| 134 | +ELDS: ',idiffmax,' SECONDS *' | |
| 135 | write(unittraj,'(a69)') '* | |
| 136 | + *' | |
| 137 | write(unittraj,'(a29,2i4,a32)') '* NUMBER OF VERTICAL LEVELS: | |
| 138 | + ',nuvz,nwz,' *' | |
| 139 | write(unittraj,'(a69)') '* | |
| 140 | + *' | |
| 141 | write(unittraj,'(a69)') '* MOTHER DOMAIN: | |
| 142 | + *' | |
| 143 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 144 | + '* LONGITUDE RANGE: ',xlon0, ' TO ',xlon0+(nx-1)*dx, | |
| 145 | + ' GRID DISTANCE: ',dx,' *' | |
| 146 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 147 | + '* LATITUDE RANGE: ',ylat0, ' TO ',ylat0+(ny-1)*dy, | |
| 148 | + ' GRID DISTANCE: ',dy,' *' | |
| 149 | ||
| 150 | do 300 l=1,numbnests | |
| 151 | write(unittraj,'(a69)') '* | |
| 152 | + *' | |
| 153 | write(unittraj,'(a,i2,a)') '* NESTED DOMAIN NUMBER: ',l,' | |
| 154 | + *' | |
| 155 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 156 | + '* LONGITUDE RANGE: ',xlon0n(l), ' TO ', | |
| 157 | + xlon0n(l)+(nxn(l)-1)*dxn(l), | |
| 158 | + ' GRID DISTANCE: ',dxn(l),' *' | |
| 159 | write(unittraj,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 160 | + '* LATITUDE RANGE: ',ylat0n(l), ' TO ', | |
| 161 | + ylat0n(l)+(nyn(l)-1)*dyn(l), | |
| 162 | + ' GRID DISTANCE: ',dyn(l),' *' | |
| 163 | 300 continue | |
| 164 | ||
| 165 | write(unittraj,'(a69)') '* | |
| 166 | + *' | |
| 167 | write(unittraj,'(a69)') '************************************* | |
| 168 | +********************************' | |
| 169 | write(unittraj,*) | |
| 170 | endif | |
| 171 | ||
| 172 | ||
| 173 | C 2. if wanted, interpolated trajectories (constant time step) | |
| 174 | ************************************************************** | |
| 175 | ||
| 176 | if (inter.ge.1) then | |
| 177 | k=index(compoint(1),' ')-1 | |
| 178 | k=min(k,20) | |
| 179 | open(unittraji,file=path(2)(1:len(2))//'FLIGHTI_'//compoint(1) | |
| 180 | + (1:k),status='new',err=999) | |
| 181 | write(unittraji,'(i8,a)') 42+4*numbnests, | |
| 182 | + ' Number of header lines' | |
| 183 | write(unittraji,'(a69)') '************************************* | |
| 184 | +********************************' | |
| 185 | write(unittraji,'(a69)') '* | |
| 186 | + *' | |
| 187 | write(unittraji,'(a69)') '* FLEXTRA MODEL O | |
| 188 | +UTPUT *' | |
| 189 | write(unittraji,'(a69)') '* FOR ECMWF WINDF | |
| 190 | +IELDS *' | |
| 191 | write(unittraji,'(a69)') '* | |
| 192 | + *' | |
| 193 | write(unittraji,'(a69)') '************************************* | |
| 194 | +********************************' | |
| 195 | write(unittraji,'(a69)') '* | |
| 196 | + *' | |
| 197 | write(unittraji,'(a,a,a)') '* TIME OF COMPUTATION: | |
| 198 | + ',datestring(1:24),' *' | |
| 199 | write(unittraji,'(a69)') '* | |
| 200 | + *' | |
| 201 | write(unittraji,'(a69)') '************************************* | |
| 202 | +********************************' | |
| 203 | write(unittraji,'(a69)') '* | |
| 204 | + *' | |
| 205 | if (kind(1).eq.1) then | |
| 206 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: 3- | |
| 207 | +DIMENSIONAL *' | |
| 208 | else if (kind(1).eq.2) then | |
| 209 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: ON | |
| 210 | + MODEL LAYERS *' | |
| 211 | else if (kind(1).eq.4) then | |
| 212 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 213 | +OBARIC *' | |
| 214 | else if (kind(1).eq.5) then | |
| 215 | write(unittraji,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 216 | +ENTROPIC *' | |
| 217 | endif | |
| 218 | write(unittraji,'(a69)') '* | |
| 219 | + *' | |
| 220 | write(unittraji,'(a69)') '************************************* | |
| 221 | +********************************' | |
| 222 | write(unittraji,'(a69)') '* | |
| 223 | + *' | |
| 224 | write(unittraji,'(a69)') '* INTEGRATION SCHEME: PE | |
| 225 | +TTERSSEN *' | |
| 226 | if (inpolkind.eq.1) then | |
| 227 | write(unittraji,'(a69)') '* INTERPOLATION METHOD: ID | |
| 228 | +EAL *' | |
| 229 | else | |
| 230 | write(unittraji,'(a69)') '* INTERPOLATION METHOD: LI | |
| 231 | +NEAR *' | |
| 232 | endif | |
| 233 | write(unittraji,'(a69)') '* | |
| 234 | + *' | |
| 235 | write(unittraji,'(a,f5.2,a)') '* SPATIAL CFL CRITERION | |
| 236 | +: ',cfl,' *' | |
| 237 | write(unittraji,'(a,f5.2,a)') '* TEMPORAL CFL CRITERION | |
| 238 | +: ',cflt,' *' | |
| 239 | write(unittraji,'(a69)') '* | |
| 240 | + *' | |
| 241 | write(unittraji,'(a69)') '************************************* | |
| 242 | +********************************' | |
| 243 | write(unittraji,'(a69)') '* | |
| 244 | + *' | |
| 245 | write(unittraji,'(a)') '* START POINT COMMENT: '// | |
| 246 | + compoint(1)(1:40)//' *' | |
| 247 | write(unittraji,'(a)') '* MODEL RUN COMMENT: '// | |
| 248 | + runcomment(1:47)//'*' | |
| 249 | write(unittraji,'(a69)') '* | |
| 250 | + *' | |
| 251 | write(unittraji,'(a69)') '************************************* | |
| 252 | +********************************' | |
| 253 | write(unittraji,'(a69)') '* | |
| 254 | + *' | |
| 255 | write(unittraji,'(a69)') '* INFORMATION ON WIND FIELDS USED FOR | |
| 256 | + COMPUTATIONS: *' | |
| 257 | write(unittraji,'(a69)') '* | |
| 258 | + *' | |
| 259 | write(unittraji,'(a,i6,a)') '* NORMAL INTERVAL BETWEEN WIND FIE | |
| 260 | +LDS: ',idiffnorm,' SECONDS *' | |
| 261 | write(unittraji,'(a,i6,a)') '* MAXIMUM INTERVAL BETWEEN WIND FI | |
| 262 | +ELDS: ',idiffmax,' SECONDS *' | |
| 263 | write(unittraji,'(a69)') '* | |
| 264 | + *' | |
| 265 | write(unittraji,'(a29,2i4,a32)') '* NUMBER OF VERTICAL LEVELS: | |
| 266 | + ',nuvz,nwz,' *' | |
| 267 | write(unittraji,'(a69)') '* | |
| 268 | + *' | |
| 269 | write(unittraji,'(a69)') '* MOTHER DOMAIN: | |
| 270 | + *' | |
| 271 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 272 | + '* LONGITUDE RANGE: ',xlon0, ' TO ',xlon0+(nx-1)*dx, | |
| 273 | + ' GRID DISTANCE: ',dx,' *' | |
| 274 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 275 | + '* LATITUDE RANGE: ',ylat0, ' TO ',ylat0+(ny-1)*dy, | |
| 276 | + ' GRID DISTANCE: ',dy,' *' | |
| 277 | ||
| 278 | do 400 l=1,numbnests | |
| 279 | write(unittraji,'(a69)') '* | |
| 280 | + *' | |
| 281 | write(unittraji,'(a,i2,a)') '* NESTED DOMAIN NUMBER: ',l,' | |
| 282 | + *' | |
| 283 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 284 | + '* LONGITUDE RANGE: ',xlon0n(l), ' TO ', | |
| 285 | + xlon0n(l)+(nxn(l)-1)*dxn(l), | |
| 286 | + ' GRID DISTANCE: ',dxn(l),' *' | |
| 287 | write(unittraji,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 288 | + '* LATITUDE RANGE: ',ylat0n(l), ' TO ', | |
| 289 | + ylat0n(l)+(nyn(l)-1)*dyn(l), | |
| 290 | + ' GRID DISTANCE: ',dyn(l),' *' | |
| 291 | 400 continue | |
| 292 | ||
| 293 | write(unittraji,'(a69)') '* | |
| 294 | + *' | |
| 295 | write(unittraji,'(a69)') '************************************* | |
| 296 | +********************************' | |
| 297 | write(unittraji,*) | |
| 298 | endif | |
| 299 | ||
| 300 | return | |
| 301 | ||
| 302 | 998 write(*,*) | |
| 303 | write(*,*) ' #### TRAJECTORY MODEL ERROR! THE FILE #### ' | |
| 304 | write(*,*) | |
| 305 | write(*,*) ' '//path(2)(1:len(2))//'FLIGHT_'//compoint(1)(1:k) | |
| 306 | write(*,*) | |
| 307 | write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### ' | |
| 308 | write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### ' | |
| 309 | write(*,*) ' #### THE PROGRAM AGAIN. #### ' | |
| 310 | error=.true. | |
| 311 | return | |
| 312 | ||
| 313 | 999 write(*,*) | |
| 314 | write(*,*) ' #### TRAJECTORY MODEL ERROR! THE FILE #### ' | |
| 315 | write(*,*) | |
| 316 | write(*,*) path(2)(1:len(2))//'FLIGHTI_'//compoint(1)(1:k) | |
| 317 | write(*,*) | |
| 318 | write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### ' | |
| 319 | write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### ' | |
| 320 | write(*,*) ' #### THE PROGRAM AGAIN. #### ' | |
| 321 | error=.true. | |
| 322 | ||
| 323 | return | |
| 324 | end |
| 0 | subroutine openoutput(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine opens the trajectory data output files. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 16 February 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * compoint(maxpoint) comment for each startpoint * | |
| 14 | * datestring date and time of model run * | |
| 15 | * error .true., if error ocurred in subprogram, else .false. * | |
| 16 | * numpoint number of starting points * | |
| 17 | * * | |
| 18 | * Constants: * | |
| 19 | * unittraj unittraj+i are connected to trajectory output (point i) * | |
| 20 | * unittraji unittraji+i are connected to interpolated trajectories * | |
| 21 | * * | |
| 22 | ******************************************************************************** | |
| 23 | ||
| 24 | include 'includepar' | |
| 25 | include 'includecom' | |
| 26 | ||
| 27 | integer i,j,k,l | |
| 28 | logical error | |
| 29 | character datestring*24 | |
| 30 | ||
| 31 | ||
| 32 | error=.false. | |
| 33 | ||
| 34 | ||
| 35 | C Check, if output file names are unequivocal | |
| 36 | ********************************************* | |
| 37 | ||
| 38 | do 1 i=1,numpoint-1 | |
| 39 | do 1 j=i+1,numpoint | |
| 40 | if (compoint(i)(1:20).eq.compoint(j)(1:20).and. | |
| 41 | + (compoint(i)(41:45).eq.compoint(j)(41:45))) then | |
| 42 | write(*,*) 'ERROR: 2 STARTING POINTS HAVE IDENTICAL NAMES.' | |
| 43 | write(*,*) 'CHANGE ONE NAME: ',compoint(i) | |
| 44 | stop | |
| 45 | endif | |
| 46 | 1 continue | |
| 47 | ||
| 48 | ||
| 49 | C Look for runtime | |
| 50 | ****************** | |
| 51 | ||
| 52 | C call fdate(datestring) | |
| 53 | ||
| 54 | ||
| 55 | C If possible, use the first 20 characters of the comment for the file | |
| 56 | C name identification. | |
| 57 | ********************************************************************* | |
| 58 | ||
| 59 | C 1. if wanted, original trajectories (flexible time step) | |
| 60 | ********************************************************** | |
| 61 | ||
| 62 | if ((inter.eq.0).or.(inter.eq.2)) then | |
| 63 | do 10 i=1,numpoint | |
| 64 | k=index(compoint(i),' ')-1 | |
| 65 | k=min(k,20) | |
| 66 | if (compoint(i)(41:41).ne.'U') then ! no uncertainty trajectory | |
| 67 | open(unittraj+i,file=path(2)(1:len(2))//'T_'//compoint(i) | |
| 68 | + (1:k),status='new',err=998) | |
| 69 | else ! uncertainty trajectory | |
| 70 | open(unittraj+i,file=path(2)(1:len(2))//'T_'//compoint(i) | |
| 71 | +(1:k)//'_U'//compoint(i)(42:45),status='new',err=998) | |
| 72 | endif | |
| 73 | write(unittraj+i,'(i8,a)') 42+4*numbnests, | |
| 74 | + ' Number of header lines' | |
| 75 | write(unittraj+i,'(a69)') '************************************* | |
| 76 | +********************************' | |
| 77 | write(unittraj+i,'(a69)') '* | |
| 78 | + *' | |
| 79 | write(unittraj+i,'(a69)') '* FLEXTRA V4.0 MODEL O | |
| 80 | +UTPUT *' | |
| 81 | write(unittraj+i,'(a69)') '* FOR ECMWF WINDF | |
| 82 | +IELDS *' | |
| 83 | write(unittraj+i,'(a69)') '* | |
| 84 | + *' | |
| 85 | write(unittraj+i,'(a69)') '************************************* | |
| 86 | +********************************' | |
| 87 | write(unittraj+i,'(a69)') '* | |
| 88 | + *' | |
| 89 | write(unittraj+i,'(a,a,a)') '* TIME OF COMPUTATION: | |
| 90 | + ' ,datestring(1:24),' *' | |
| 91 | write(unittraj+i,'(a69)') '* | |
| 92 | + *' | |
| 93 | write(unittraj+i,'(a69)') '************************************* | |
| 94 | +********************************' | |
| 95 | write(unittraj+i,'(a69)') '* | |
| 96 | + *' | |
| 97 | if (kind(i).eq.1) then | |
| 98 | write(unittraj+i,'(a69)') '* TYPE OF TRAJECTORIES: 3- | |
| 99 | +DIMENSIONAL *' | |
| 100 | else if (kind(i).eq.2) then | |
| 101 | write(unittraj+i,'(a69)') '* TYPE OF TRAJECTORIES: ON | |
| 102 | + MODEL LAYERS *' | |
| 103 | else if (kind(i).eq.3) then | |
| 104 | write(unittraj+i,'(a69)') '* TYPE OF TRAJECTORIES: MI | |
| 105 | +XED LAYER *' | |
| 106 | else if (kind(i).eq.4) then | |
| 107 | write(unittraj+i,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 108 | +OBARIC *' | |
| 109 | else if (kind(i).eq.5) then | |
| 110 | write(unittraj+i,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 111 | +ENTROPIC *' | |
| 112 | endif | |
| 113 | write(unittraj+i,'(a69)') '* | |
| 114 | + *' | |
| 115 | write(unittraj+i,'(a69)') '************************************* | |
| 116 | +********************************' | |
| 117 | write(unittraj+i,'(a69)') '* | |
| 118 | + *' | |
| 119 | write(unittraj+i,'(a69)') '* INTEGRATION SCHEME: PE | |
| 120 | +TTERSSEN *' | |
| 121 | if (inpolkind.eq.1) then | |
| 122 | write(unittraj+i,'(a69)') '* INTERPOLATION METHOD: ID | |
| 123 | +EAL *' | |
| 124 | else | |
| 125 | write(unittraj+i,'(a69)') '* INTERPOLATION METHOD: LI | |
| 126 | +NEAR *' | |
| 127 | endif | |
| 128 | write(unittraj+i,'(a69)') '* | |
| 129 | + *' | |
| 130 | write(unittraj+i,'(a,f5.2,a)') '* SPATIAL CFL CRITERION | |
| 131 | +: ',cfl,' *' | |
| 132 | write(unittraj+i,'(a,f5.2,a)') '* TEMPORAL CFL CRITERION | |
| 133 | +: ',cflt,' *' | |
| 134 | write(unittraj+i,'(a69)') '* | |
| 135 | + *' | |
| 136 | write(unittraj+i,'(a69)') '************************************* | |
| 137 | +********************************' | |
| 138 | write(unittraj+i,'(a69)') '* | |
| 139 | + *' | |
| 140 | write(unittraj+i,'(a)') '* START POINT COMMENT: '// | |
| 141 | + compoint(i)(1:40)//' *' | |
| 142 | write(unittraj+i,'(a)') '* MODEL RUN COMMENT: '// | |
| 143 | + runcomment(1:47)//'*' | |
| 144 | write(unittraj+i,'(a69)') '* | |
| 145 | + *' | |
| 146 | write(unittraj+i,'(a69)') '************************************* | |
| 147 | +********************************' | |
| 148 | write(unittraj+i,'(a69)') '* | |
| 149 | + *' | |
| 150 | write(unittraj+i,'(a69)') '* INFORMATION ON WIND FIELDS USED FOR | |
| 151 | + COMPUTATIONS: *' | |
| 152 | write(unittraj+i,'(a69)') '* | |
| 153 | + *' | |
| 154 | write(unittraj+i,'(a,i6,a)') '* NORMAL INTERVAL BETWEEN WIND FIE | |
| 155 | +LDS: ',idiffnorm,' SECONDS *' | |
| 156 | write(unittraj+i,'(a,i6,a)') '* MAXIMUM INTERVAL BETWEEN WIND FI | |
| 157 | +ELDS: ',idiffmax,' SECONDS *' | |
| 158 | write(unittraj+i,'(a69)') '* | |
| 159 | + *' | |
| 160 | write(unittraj+i,'(a29,2i4,a32)') '* NUMBER OF VERTICAL LEVELS: | |
| 161 | + ',nuvz,nwz,' *' | |
| 162 | write(unittraj+i,'(a69)') '* | |
| 163 | + *' | |
| 164 | write(unittraj+i,'(a69)') '* MOTHER DOMAIN: | |
| 165 | + *' | |
| 166 | write(unittraj+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 167 | + '* LONGITUDE RANGE: ',xlon0, ' TO ',xlon0+(nx-1)*dx, | |
| 168 | + ' GRID DISTANCE: ',dx,' *' | |
| 169 | write(unittraj+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 170 | + '* LATITUDE RANGE: ',ylat0, ' TO ',ylat0+(ny-1)*dy, | |
| 171 | + ' GRID DISTANCE: ',dy,' *' | |
| 172 | ||
| 173 | do 300 l=1,numbnests | |
| 174 | write(unittraj+i,'(a69)') '* | |
| 175 | + *' | |
| 176 | write(unittraj+i,'(a,i2,a)') '* NESTED DOMAIN NUMBER: ',l,' | |
| 177 | + *' | |
| 178 | write(unittraj+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 179 | + '* LONGITUDE RANGE: ',xlon0n(l), ' TO ', | |
| 180 | + xlon0n(l)+(nxn(l)-1)*dxn(l), | |
| 181 | + ' GRID DISTANCE: ',dxn(l),' *' | |
| 182 | write(unittraj+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 183 | + '* LATITUDE RANGE: ',ylat0n(l), ' TO ', | |
| 184 | + ylat0n(l)+(nyn(l)-1)*dyn(l), | |
| 185 | + ' GRID DISTANCE: ',dyn(l),' *' | |
| 186 | 300 continue | |
| 187 | ||
| 188 | write(unittraj+i,'(a69)') '* | |
| 189 | + *' | |
| 190 | write(unittraj+i,'(a69)') '************************************* | |
| 191 | +********************************' | |
| 192 | write(unittraj+i,*) | |
| 193 | 10 continue | |
| 194 | endif | |
| 195 | ||
| 196 | ||
| 197 | C 2. if wanted, interpolated trajectories (constant time step) | |
| 198 | ************************************************************** | |
| 199 | ||
| 200 | if (inter.ge.1) then | |
| 201 | do 20 i=1,numpoint | |
| 202 | k=index(compoint(i),' ')-1 | |
| 203 | k=min(k,40) | |
| 204 | if (compoint(i)(41:41).ne.'U') then ! no uncertainty trajectory | |
| 205 | open(unittraji+i,file=path(2)(1:len(2))//'TI_'//compoint(i) | |
| 206 | + (1:k),status='new',err=999) | |
| 207 | else ! uncertainty trajectory | |
| 208 | open(unittraji+i,file=path(2)(1:len(2))//'TI_'//compoint(i) | |
| 209 | +(1:k)//'_U'//compoint(i)(42:45),status='new',err=999) | |
| 210 | endif | |
| 211 | write(unittraji+i,'(i8,a)') 42+4*numbnests, | |
| 212 | + ' Number of header lines' | |
| 213 | write(unittraji+i,'(a69)') '************************************* | |
| 214 | +********************************' | |
| 215 | write(unittraji+i,'(a69)') '* | |
| 216 | + *' | |
| 217 | write(unittraji+i,'(a69)') '* FLEXTRA MODEL O | |
| 218 | +UTPUT *' | |
| 219 | write(unittraji+i,'(a69)') '* FOR ECMWF WINDF | |
| 220 | +IELDS *' | |
| 221 | write(unittraji+i,'(a69)') '* | |
| 222 | + *' | |
| 223 | write(unittraji+i,'(a69)') '************************************* | |
| 224 | +********************************' | |
| 225 | write(unittraji+i,'(a69)') '* | |
| 226 | + *' | |
| 227 | write(unittraji+i,'(a,a,a)') '* TIME OF COMPUTATION: | |
| 228 | + ',datestring(1:24),' *' | |
| 229 | write(unittraji+i,'(a69)') '* | |
| 230 | + *' | |
| 231 | write(unittraji+i,'(a69)') '************************************* | |
| 232 | +********************************' | |
| 233 | write(unittraji+i,'(a69)') '* | |
| 234 | + *' | |
| 235 | if (kind(i).eq.1) then | |
| 236 | write(unittraji+i,'(a69)') '* TYPE OF TRAJECTORIES: 3- | |
| 237 | +DIMENSIONAL *' | |
| 238 | else if (kind(i).eq.2) then | |
| 239 | write(unittraji+i,'(a69)') '* TYPE OF TRAJECTORIES: ON | |
| 240 | + MODEL LAYERS *' | |
| 241 | else if (kind(i).eq.3) then | |
| 242 | write(unittraji+i,'(a69)') '* TYPE OF TRAJECTORIES: MI | |
| 243 | +XED LAYER *' | |
| 244 | else if (kind(i).eq.4) then | |
| 245 | write(unittraji+i,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 246 | +OBARIC *' | |
| 247 | else if (kind(i).eq.5) then | |
| 248 | write(unittraji+i,'(a69)') '* TYPE OF TRAJECTORIES: IS | |
| 249 | +ENTROPIC *' | |
| 250 | endif | |
| 251 | write(unittraji+i,'(a69)') '* | |
| 252 | + *' | |
| 253 | write(unittraji+i,'(a69)') '************************************* | |
| 254 | +********************************' | |
| 255 | write(unittraji+i,'(a69)') '* | |
| 256 | + *' | |
| 257 | write(unittraji+i,'(a69)') '* INTEGRATION SCHEME: PE | |
| 258 | +TTERSSEN *' | |
| 259 | if (inpolkind.eq.1) then | |
| 260 | write(unittraji+i,'(a69)') '* INTERPOLATION METHOD: ID | |
| 261 | +EAL *' | |
| 262 | else | |
| 263 | write(unittraji+i,'(a69)') '* INTERPOLATION METHOD: LI | |
| 264 | +NEAR *' | |
| 265 | endif | |
| 266 | write(unittraji+i,'(a69)') '* | |
| 267 | + *' | |
| 268 | write(unittraji+i,'(a,f5.2,a)') '* SPATIAL CFL CRITERION | |
| 269 | +: ',cfl,' *' | |
| 270 | write(unittraji+i,'(a,f5.2,a)') '* TEMPORAL CFL CRITERION | |
| 271 | +: ',cflt,' *' | |
| 272 | write(unittraji+i,'(a69)') '* | |
| 273 | + *' | |
| 274 | write(unittraji+i,'(a69)') '************************************* | |
| 275 | +********************************' | |
| 276 | write(unittraji+i,'(a69)') '* | |
| 277 | + *' | |
| 278 | write(unittraji+i,'(a)') '* START POINT COMMENT: '// | |
| 279 | + compoint(i)(1:40)//' *' | |
| 280 | write(unittraji+i,'(a)') '* MODEL RUN COMMENT: '// | |
| 281 | + runcomment(1:47)//'*' | |
| 282 | write(unittraji+i,'(a69)') '* | |
| 283 | + *' | |
| 284 | write(unittraji+i,'(a69)') '************************************* | |
| 285 | +********************************' | |
| 286 | write(unittraji+i,'(a69)') '* | |
| 287 | + *' | |
| 288 | write(unittraji+i,'(a69)') '* INFORMATION ON WIND FIELDS USED FOR | |
| 289 | + COMPUTATIONS: *' | |
| 290 | write(unittraji+i,'(a69)') '* | |
| 291 | + *' | |
| 292 | write(unittraji+i,'(a,i6,a)') '* NORMAL INTERVAL BETWEEN WIND FIE | |
| 293 | +LDS: ',idiffnorm,' SECONDS *' | |
| 294 | write(unittraji+i,'(a,i6,a)') '* MAXIMUM INTERVAL BETWEEN WIND FI | |
| 295 | +ELDS: ',idiffmax,' SECONDS *' | |
| 296 | write(unittraji+i,'(a69)') '* | |
| 297 | + *' | |
| 298 | write(unittraji+i,'(a29,2i4,a32)') '* NUMBER OF VERTICAL LEVELS: | |
| 299 | + ',nuvz,nwz,' *' | |
| 300 | write(unittraji+i,'(a69)') '* | |
| 301 | + *' | |
| 302 | write(unittraji+i,'(a69)') '* MOTHER DOMAIN: | |
| 303 | + *' | |
| 304 | write(unittraji+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 305 | + '* LONGITUDE RANGE: ',xlon0, ' TO ',xlon0+(nx-1)*dx, | |
| 306 | + ' GRID DISTANCE: ',dx,' *' | |
| 307 | write(unittraji+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 308 | + '* LATITUDE RANGE: ',ylat0, ' TO ',ylat0+(ny-1)*dy, | |
| 309 | + ' GRID DISTANCE: ',dy,' *' | |
| 310 | ||
| 311 | do 400 l=1,numbnests | |
| 312 | write(unittraji+i,'(a69)') '* | |
| 313 | + *' | |
| 314 | write(unittraji+i,'(a,i2,a)') '* NESTED DOMAIN NUMBER: ',l,' | |
| 315 | + *' | |
| 316 | write(unittraji+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 317 | + '* LONGITUDE RANGE: ',xlon0n(l), ' TO ', | |
| 318 | + xlon0n(l)+(nxn(l)-1)*dxn(l), | |
| 319 | + ' GRID DISTANCE: ',dxn(l),' *' | |
| 320 | write(unittraji+i,'(a,f7.2,a,f7.2,a,f6.2,a)') | |
| 321 | + '* LATITUDE RANGE: ',ylat0n(l), ' TO ', | |
| 322 | + ylat0n(l)+(nyn(l)-1)*dyn(l), | |
| 323 | + ' GRID DISTANCE: ',dyn(l),' *' | |
| 324 | 400 continue | |
| 325 | ||
| 326 | write(unittraji+i,'(a69)') '* | |
| 327 | + *' | |
| 328 | write(unittraji+i,'(a69)') '************************************* | |
| 329 | +********************************' | |
| 330 | write(unittraji+i,*) | |
| 331 | 20 continue | |
| 332 | endif | |
| 333 | ||
| 334 | return | |
| 335 | ||
| 336 | 998 write(*,*) | |
| 337 | write(*,*) ' #### TRAJECTORY MODEL ERROR! THE FILE #### ' | |
| 338 | write(*,*) | |
| 339 | write(*,*) ' '//path(2)(1:len(2))//'T_'//compoint(i)(1:k) | |
| 340 | write(*,*) | |
| 341 | write(*,*) ' #### (OR THIS FILE WITH A "_U" AT THE END) #### ' | |
| 342 | write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### ' | |
| 343 | write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### ' | |
| 344 | write(*,*) ' #### THE PROGRAM AGAIN. #### ' | |
| 345 | error=.true. | |
| 346 | return | |
| 347 | ||
| 348 | 999 write(*,*) | |
| 349 | write(*,*) ' #### TRAJECTORY MODEL ERROR! THE FILE #### ' | |
| 350 | write(*,*) | |
| 351 | write(*,*) ' '//path(2)(1:len(2))//'TI_'//compoint(i)(1:k) | |
| 352 | write(*,*) | |
| 353 | write(*,*) ' #### (OR THIS FILE WITH A "_U" AT THE END) #### ' | |
| 354 | write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS #### ' | |
| 355 | write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### ' | |
| 356 | write(*,*) ' #### THE PROGRAM AGAIN. #### ' | |
| 357 | error=.true. | |
| 358 | ||
| 359 | return | |
| 360 | end |
| 0 | ******************************************************************************** | |
| 1 | * * | |
| 2 | * Input file for the trajectory model FLEXTRA: Please select your options * | |
| 3 | * * | |
| 4 | ******************************************************************************** | |
| 5 | ||
| 6 | 1. __________________________________________________ 3X, A50 | |
| 7 | Test run #1 | |
| 8 | LABEL FOR THE MODEL RUN | |
| 9 | ||
| 10 | 2. __ 3X, I2 | |
| 11 | 1 | |
| 12 | DIRECTION 1 FORWARD, -1 BACKWARD TRAJECTORIES | |
| 13 | ||
| 14 | 3. _______ 3X, I7 | |
| 15 | 2400000 | |
| 16 | HHHMISS LENGTH OF AN INDIVIDUAL TRAJECTORY | |
| 17 | ||
| 18 | 4. ________ ______ 3X, I8, 1X, I6 | |
| 19 | 20100828 223000 | |
| 20 | YYYYMMDD HHMISS BEGINNING DATE | |
| 21 | ||
| 22 | 5. ________ ______ 3X, I8, 1X, I6 | |
| 23 | 20100828 223000 | |
| 24 | YYYYMMDD HHMISS ENDING DATE | |
| 25 | ||
| 26 | 6. _______ 3X, I7 | |
| 27 | 0060000 | |
| 28 | HHHMISS TIME INTERVAL BETWEEN STARTING TIMES OF TRAJECTORIES | |
| 29 | ||
| 30 | 7. _ _____ 3X, I1, 2X, I5 | |
| 31 | 1 10800 | |
| 32 | i SSSSS i>0: INTERPOLATED OUTPUT OF TRAJECTORY EVERY SSSSS SECONDS | |
| 33 | ||
| 34 | 8. _____ ___.___ _.___ _.___ _.___ _.___ 3X, I5, 2X, F7.3 4(2X,F5.3) | |
| 35 | 00000 000.500 2.000 0.080 0.080 0.200 | |
| 36 | NUMBER NUMBER, DISTANCE (GRID UNITS), TIME CONSTANT (WIND FIELD INTERVAL UNITS) AND INTERPOLATION ERRORS (IN U, V AND W) OF UNCERTAINTY TRAJECT. | |
| 37 | ||
| 38 | 9. _ 3X, I1 | |
| 39 | 1 | |
| 40 | INTERPOLATION 1 = IDEAL INTERPOLATION >1 = LINEAR INTERPOLATION | |
| 41 | ||
| 42 | 10. ---.-- 4X, F6.4 | |
| 43 | 5.0 | |
| 44 | CFL TIMESTEP CRITERION HORIZONTAL AND VERTICAL | |
| 45 | ||
| 46 | 11. ---.-- 4X, F6.4 | |
| 47 | 5.0 | |
| 48 | CFLT TIMESTEP CRITERION TIME GAP BETWEEN INPUT WIND FIELDS | |
| 49 | ||
| 50 | 12. - 4X, I1 | |
| 51 | 1 | |
| 52 | MODE 1 NORMAL MODE, 2 CET MODE, 3 FLIGHT MODE | |
| 53 | =================================================================== | |
| 54 | 1. Comment to identify the current model run | |
| 55 | ||
| 56 | 2. Direction of trajectories (1 means forward trajectories, -1 backward) | |
| 57 | ||
| 58 | 3. Temporal lengths of the trajectories in the format HHHMISS, where HHH is | |
| 59 | HOUR, MI is MINUTE and SS is SECOND | |
| 60 | ||
| 61 | 4. Beginning date and time of trajectory calculation. Must be given in format | |
| 62 | YYYYMMDD HHMISS, where YYYY is YEAR, MM is MONTH, DD is DAY, HH is HOUR, | |
| 63 | MI is MINUTE and SS is SECOND. All times are in UTC. | |
| 64 | ||
| 65 | 5. Ending date and time of trajectory calculation. Same format as 4. | |
| 66 | ||
| 67 | 6. Time interval between two trajectory calculations. Same format as 3. | |
| 68 | ||
| 69 | 7. Options for the trajectory output: | |
| 70 | 0 = original data in irregular time intervals | |
| 71 | 1 = constant time intervals, interpolated output every SSSSS seconds | |
| 72 | 2 = 0 plus 1 | |
| 73 | ||
| 74 | 8. Six parameters have to be inputted. The first is the number of | |
| 75 | uncertainty trajectories. They are starting in a distance from | |
| 76 | the starting point of the reference trajectory as given by the | |
| 77 | second parameter (in grid units). | |
| 78 | Additionally, random errors may be added at each time step of the | |
| 79 | trajectory calculation. Using a Langevin equation, they are relaxed | |
| 80 | with a time constant (in units of the wind field interval, third | |
| 81 | parameter) specified by the user. These random errors are | |
| 82 | thought to reflect typical wind errors caused, for instance, by | |
| 83 | interpolation. The magnitude of these errors (in relative units, | |
| 84 | relative to the wind velocity) must be specified by the user for | |
| 85 | the three wind components u, v and w (last three parameters). | |
| 86 | ||
| 87 | 9. Kind of interpolation | |
| 88 | 1 - horizontal interpolation bicubic | |
| 89 | vertical interpolation polynomial | |
| 90 | temporal interpolation linear | |
| 91 | >1 - horizontal interpolation bilinear | |
| 92 | vertical interpolation linear | |
| 93 | temporal interpolation linear | |
| 94 | ||
| 95 | 10.cfl criterion horizontal/vertical | |
| 96 | factor by which time step must be shorter than that determined | |
| 97 | from the CFL criterion, i.e. | |
| 98 | ||
| 99 | delta_t1=delta x/u/cfl | |
| 100 | delta_t2=delta y/v/cfl | |
| 101 | delta_t3=delta z/w/cfl | |
| 102 | ||
| 103 | delta_t(space) = min(delta_t1,delta_t2,delta_t3) | |
| 104 | ||
| 105 | 11. cfl criterion time | |
| 106 | factor by wich time is shorter than time interval of the wind | |
| 107 | fields | |
| 108 | ||
| 109 | delta_t(time) = delta_T(input wind)/cflt | |
| 110 | ||
| 111 | The time step used for trajectory calculation is the minimum of | |
| 112 | delta_t(space) and delta_t(time) | |
| 113 | ||
| 114 | cfl and cflt must not be less than 1! | |
| 115 | ||
| 116 | 12. 1 NORMAL mode -> read file STARTPOINTS and calculate a time | |
| 117 | series of trajectories starting all from the same starting | |
| 118 | points | |
| 119 | 2 CET mode -> read file STARTCET and calculate trajectories | |
| 120 | starting uniformly spaced from a user-defined domain | |
| 121 | (for a single starting time) | |
| 122 | 3 FLIGHT mode -> read file STARTFLIGHT and calculate | |
| 123 | trajectories starting neither uniformly spaced nor with | |
| 124 | constant time intervals (as needed, for instance, to start | |
| 125 | trajectories along an aircraft leg) |
| 0 | ******************************************************************************** | |
| 1 | * * | |
| 2 | * Input file for the trajectory model FLEXTRA: Please select your options * | |
| 3 | * * | |
| 4 | ******************************************************************************** | |
| 5 | ||
| 6 | 'Test run #1' LABEL FOR THE MODEL RUN | |
| 7 | 1 DIRECTION (1 FORWARD, -1 BACKWARD TRAJECT.) | |
| 8 | 480000 HHHMISS LENGTH OF AN INDIVIDUAL TRAJECTORY | |
| 9 | 19980402 120000 YYYYMMDD HHMISS BEGINNING DATE | |
| 10 | 19980406 150000 YYYYMMDD HHMISS ENDING DATE | |
| 11 | 060000 HHHMISS TIME INTERVAL BETWEEN STARTING TIMES OF TRAJECTORIES | |
| 12 | 2 3600 i SSSSS i>0: INTERPOLATED OUTPUT OF TRAJECTORY EVERY SSSSS SECONDS | |
| 13 | 0 0.5 2.0 0.08 0.08 0.20 NUMBER, DISTANCE (GRID UNITS), TIME CONSTANT (WIND FIELD INTERVAL UNITS) AND INTERPOLATION ERRORS (IN U, V AND W) OF UNCERTAINTY TRAJECT. | |
| 14 | 1 INTERPOLATION 1 = IDEAL INTERPOLATION >1 = LINEAR INTERPOLATION | |
| 15 | 5.0 CFL TIMESTEP CRITERION HORIZONTAL AND VERTICAL | |
| 16 | 5.0 CFLT TIMESTEP CRITERION TIME GAP BETWEEN INPUT WIND FIELDS | |
| 17 | 3 MODE 1 NORMAL MODE, 2 CET MODE, 3 FLIGHT MODE | |
| 18 | ================================================================================== | |
| 19 | 1. Comment to identify the current model run | |
| 20 | ||
| 21 | 2. Direction of trajectories (1 means forward trajectories, -1 backward) | |
| 22 | ||
| 23 | 3. Temporal lengths of the trajectories in the format HHHMISS, where HHH is | |
| 24 | HOUR, MI is MINUTE and SS is SECOND | |
| 25 | ||
| 26 | 4. Beginning date and time of trajectory calculation. Must be given in format | |
| 27 | YYYYMMDD HHMISS, where YYYY is YEAR, MM is MONTH, DD is DAY, HH is HOUR, | |
| 28 | MI is MINUTE and SS is SECOND. All times are in UTC. | |
| 29 | ||
| 30 | 5. Ending date and time of trajectory calculation. Same format as 4. | |
| 31 | ||
| 32 | 6. Time interval between two trajectory calculations. Same format as 3. | |
| 33 | ||
| 34 | 7. Options for the trajectory output: | |
| 35 | 0 = original data in irregular time intervals | |
| 36 | 1 = constant time intervals, interpolated output every SSSSS seconds | |
| 37 | 2 = 0 plus 1 | |
| 38 | ||
| 39 | 8. Six parameters have to be inputted. The first is the number of | |
| 40 | uncertainty trajectories. They are starting in a distance from | |
| 41 | the starting point of the reference trajectory as given by the | |
| 42 | second parameter (in grid units). | |
| 43 | Additionally, random errors may be added at each time step of the | |
| 44 | trajectory calculation. Using a Langevin equation, they are relaxed | |
| 45 | with a time constant (in units of the wind field interval, third | |
| 46 | parameter) specified by the user. These random errors are | |
| 47 | thought to reflect typical wind errors caused, for instance, by | |
| 48 | interpolation. The magnitude of these errors (in relative units, | |
| 49 | relative to the wind velocity) must be specified by the user for | |
| 50 | the three wind components u, v and w (last three parameters). | |
| 51 | ||
| 52 | 9. Kind of interpolation | |
| 53 | 1 - horizontal interpolation bicubic | |
| 54 | vertical interpolation polynomial | |
| 55 | temporal interpolation linear | |
| 56 | >1 - horizontal interpolation bilinear | |
| 57 | vertical interpolation linear | |
| 58 | temporal interpolation linear | |
| 59 | ||
| 60 | 10.cfl criterion horizontal/vertical | |
| 61 | factor by which time step must be shorter than that determined | |
| 62 | from the CFL criterion, i.e. | |
| 63 | ||
| 64 | delta_t1=delta x/u/cfl | |
| 65 | delta_t2=delta y/v/cfl | |
| 66 | delta_t3=delta z/w/cfl | |
| 67 | ||
| 68 | delta_t(space) = min(delta_t1,delta_t2,delta_t3) | |
| 69 | ||
| 70 | 11. cfl criterion time | |
| 71 | factor by wich time is shorter than time interval of the wind | |
| 72 | fields | |
| 73 | ||
| 74 | delta_t(time) = delta_T(input wind)/cflt | |
| 75 | ||
| 76 | The time step used for trajectory calculation is the minimum of | |
| 77 | delta_t(space) and delta_t(time) | |
| 78 | ||
| 79 | cfl and cflt must not be less than 1! | |
| 80 | ||
| 81 | 12. 1 NORMAL mode -> read file STARTPOINTS and calculate a time | |
| 82 | series of trajectories starting all from the same starting | |
| 83 | points | |
| 84 | 2 CET mode -> read file STARTCET and calculate trajectories | |
| 85 | starting uniformly spaced from a user-defined domain | |
| 86 | (for a single starting time) | |
| 87 | 3 FLIGHT mode -> read file STARTFLIGHT and calculate | |
| 88 | trajectories starting neither uniformly spaced nor with | |
| 89 | constant time intervals (as needed, for instance, to start | |
| 90 | trajectories along an aircraft leg) |
| 0 | ******************************************************************************** | |
| 1 | * * | |
| 2 | * Input file for the trajectory model FLEXTRA: Please select your options * | |
| 3 | * * | |
| 4 | ******************************************************************************** | |
| 5 | ||
| 6 | 1. __________________________________________________ 3X, A50 | |
| 7 | Test run #1 | |
| 8 | LABEL FOR THE MODEL RUN | |
| 9 | ||
| 10 | 2. __ 3X, I2 | |
| 11 | -1 | |
| 12 | DIRECTION 1 FORWARD, -1 BACKWARD TRAJECTORIES | |
| 13 | ||
| 14 | 3. _______ 3X, I7 | |
| 15 | 960000 | |
| 16 | HHHMISS LENGTH OF AN INDIVIDUAL TRAJECTORY | |
| 17 | ||
| 18 | 4. ________ ______ 3X, I8, 1X, I6 | |
| 19 | 19980402 150000 | |
| 20 | YYYYMMDD HHMISS BEGINNING DATE | |
| 21 | ||
| 22 | 5. ________ ______ 3X, I8, 1X, I6 | |
| 23 | 19980405 120000 | |
| 24 | YYYYMMDD HHMISS ENDING DATE | |
| 25 | ||
| 26 | 6. _______ 3X, I7 | |
| 27 | 0060000 | |
| 28 | HHHMISS TIME INTERVAL BETWEEN STARTING TIMES OF TRAJECTORIES | |
| 29 | ||
| 30 | 7. _ _____ 3X, I1, 2X, I5 | |
| 31 | 1 10800 | |
| 32 | i SSSSS i>0: INTERPOLATED OUTPUT OF TRAJECTORY EVERY SSSSS SECONDS | |
| 33 | ||
| 34 | 8. _____ ___.___ _.___ _.___ _.___ _.___ 3X, I5, 2X, F7.3 4(2X,F5.3) | |
| 35 | 00000 000.500 2.000 0.080 0.080 0.200 | |
| 36 | NUMBER NUMBER, DISTANCE (GRID UNITS), TIME CONSTANT (WIND FIELD INTERVAL UNITS) AND INTERPOLATION ERRORS (IN U, V AND W) OF UNCERTAINTY TRAJECT. | |
| 37 | ||
| 38 | 9. _ 3X, I1 | |
| 39 | 1 | |
| 40 | INTERPOLATION 1 = IDEAL INTERPOLATION >1 = LINEAR INTERPOLATION | |
| 41 | ||
| 42 | 10. ---.-- 4X, F6.4 | |
| 43 | 5.0 | |
| 44 | CFL TIMESTEP CRITERION HORIZONTAL AND VERTICAL | |
| 45 | ||
| 46 | 11. ---.-- 4X, F6.4 | |
| 47 | 5.0 | |
| 48 | CFLT TIMESTEP CRITERION TIME GAP BETWEEN INPUT WIND FIELDS | |
| 49 | ||
| 50 | 12. - 4X, I1 | |
| 51 | 1 | |
| 52 | MODE 1 NORMAL MODE, 2 CET MODE, 3 FLIGHT MODE | |
| 53 | =================================================================== | |
| 54 | 1. Comment to identify the current model run | |
| 55 | ||
| 56 | 2. Direction of trajectories (1 means forward trajectories, -1 backward) | |
| 57 | ||
| 58 | 3. Temporal lengths of the trajectories in the format HHHMISS, where HHH is | |
| 59 | HOUR, MI is MINUTE and SS is SECOND | |
| 60 | ||
| 61 | 4. Beginning date and time of trajectory calculation. Must be given in format | |
| 62 | YYYYMMDD HHMISS, where YYYY is YEAR, MM is MONTH, DD is DAY, HH is HOUR, | |
| 63 | MI is MINUTE and SS is SECOND. All times are in UTC. | |
| 64 | ||
| 65 | 5. Ending date and time of trajectory calculation. Same format as 4. | |
| 66 | ||
| 67 | 6. Time interval between two trajectory calculations. Same format as 3. | |
| 68 | ||
| 69 | 7. Options for the trajectory output: | |
| 70 | 0 = original data in irregular time intervals | |
| 71 | 1 = constant time intervals, interpolated output every SSSSS seconds | |
| 72 | 2 = 0 plus 1 | |
| 73 | ||
| 74 | 8. Six parameters have to be inputted. The first is the number of | |
| 75 | uncertainty trajectories. They are starting in a distance from | |
| 76 | the starting point of the reference trajectory as given by the | |
| 77 | second parameter (in grid units). | |
| 78 | Additionally, random errors may be added at each time step of the | |
| 79 | trajectory calculation. Using a Langevin equation, they are relaxed | |
| 80 | with a time constant (in units of the wind field interval, third | |
| 81 | parameter) specified by the user. These random errors are | |
| 82 | thought to reflect typical wind errors caused, for instance, by | |
| 83 | interpolation. The magnitude of these errors (in relative units, | |
| 84 | relative to the wind velocity) must be specified by the user for | |
| 85 | the three wind components u, v and w (last three parameters). | |
| 86 | ||
| 87 | 9. Kind of interpolation | |
| 88 | 1 - horizontal interpolation bicubic | |
| 89 | vertical interpolation polynomial | |
| 90 | temporal interpolation linear | |
| 91 | >1 - horizontal interpolation bilinear | |
| 92 | vertical interpolation linear | |
| 93 | temporal interpolation linear | |
| 94 | ||
| 95 | 10.cfl criterion horizontal/vertical | |
| 96 | factor by which time step must be shorter than that determined | |
| 97 | from the CFL criterion, i.e. | |
| 98 | ||
| 99 | delta_t1=delta x/u/cfl | |
| 100 | delta_t2=delta y/v/cfl | |
| 101 | delta_t3=delta z/w/cfl | |
| 102 | ||
| 103 | delta_t(space) = min(delta_t1,delta_t2,delta_t3) | |
| 104 | ||
| 105 | 11. cfl criterion time | |
| 106 | factor by wich time is shorter than time interval of the wind | |
| 107 | fields | |
| 108 | ||
| 109 | delta_t(time) = delta_T(input wind)/cflt | |
| 110 | ||
| 111 | The time step used for trajectory calculation is the minimum of | |
| 112 | delta_t(space) and delta_t(time) | |
| 113 | ||
| 114 | cfl and cflt must not be less than 1! | |
| 115 | ||
| 116 | 12. 1 NORMAL mode -> read file STARTPOINTS and calculate a time | |
| 117 | series of trajectories starting all from the same starting | |
| 118 | points | |
| 119 | 2 CET mode -> read file STARTCET and calculate trajectories | |
| 120 | starting uniformly spaced from a user-defined domain | |
| 121 | (for a single starting time) | |
| 122 | 3 FLIGHT mode -> read file STARTFLIGHT and calculate | |
| 123 | trajectories starting neither uniformly spaced nor with | |
| 124 | constant time intervals (as needed, for instance, to start | |
| 125 | trajectories along an aircraft leg) |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF THE CET DOMAIN * | |
| 4 | * A CET STARTING DOMAIN IS DEFINED BY THE LOWER LEFT AND UPPER RIGHT* | |
| 5 | * CORNER IN A LATITUDE/LONGITUDE COORDINATE SYSTEM, AND BY A LOWER * | |
| 6 | * AND UPPER LEVEL. TRAJECTORIES ARE STARTED AT DISTANCES DX, DY AND * | |
| 7 | * DZ WITHIN THIS DOMAIN. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = not allowed in CET mode * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * The vertical distance DZ between the trajectories must be * | |
| 22 | * given in the same units. * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | -20.0 F Lower left longitude [DEG] | |
| 27 | 20.0 F Lower left latitude [DEG] | |
| 28 | 40.0 F Upper right longitude [DEG] | |
| 29 | 70.0 F Upper right latitude [DEG] | |
| 30 | 1.0 F DX: Longitudinal distance between trajectories [DEG] | |
| 31 | 1.0 F DY: Latitudinal distance between trajectories [DEG] | |
| 32 | 1 I Kind of trajectory (see file header) | |
| 33 | 3 I Unit of z coordinate | |
| 34 | 500.0 F Lower z-coordinate (see file header) | |
| 35 | 500.0 F Upper z-coordinate (see file header) | |
| 36 | 200.0 F DZ: Vertical interval of trajectories (see file header) | |
| 37 | 'TESTCET' | |
| 38 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF THE CET DOMAIN * | |
| 4 | * A CET STARTING DOMAIN IS DEFINED BY THE LOWER LEFT AND UPPER RIGHT* | |
| 5 | * CORNER IN A LATITUDE/LONGITUDE COORDINATE SYSTEM, AND BY A LOWER * | |
| 6 | * AND UPPER LEVEL. TRAJECTORIES ARE STARTED AT DISTANCES DX, DY AND * | |
| 7 | * DZ WITHIN THIS DOMAIN. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = not allowed in CET mode * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * The vertical distance DZ between the trajectories must be * | |
| 22 | * given in the same units. * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | 10.0 F Lower left longitude [DEG] | |
| 27 | 48.0 F Lower left latitude [DEG] | |
| 28 | 15.0 F Upper right longitude [DEG] | |
| 29 | 50.0 F Upper right latitude [DEG] | |
| 30 | 0.5 F DX: Longitudinal distance between trajectories [DEG] | |
| 31 | 0.5 F DY: Latitudinal distance between trajectories [DEG] | |
| 32 | 5 I Kind of trajectory (see file header) | |
| 33 | 2 I Unit of z coordinate | |
| 34 | 2000.0 F Lower z-coordinate (see file header) | |
| 35 | 3000.0 F Upper z-coordinate (see file header) | |
| 36 | 500.0 F DZ: Vertical interval of trajectories (see file header) | |
| 37 | 'TEST' | |
| 38 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF THE CET DOMAIN * | |
| 4 | * A CET STARTING DOMAIN IS DEFINED BY THE LOWER LEFT AND UPPER RIGHT* | |
| 5 | * CORNER IN A LATITUDE/LONGITUDE COORDINATE SYSTEM, AND BY A LOWER * | |
| 6 | * AND UPPER LEVEL. TRAJECTORIES ARE STARTED AT DISTANCES DX, DY AND * | |
| 7 | * DZ WITHIN THIS DOMAIN. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = not allowed in CET mode * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * The vertical distance DZ between the trajectories must be * | |
| 22 | * given in the same units. * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | 10.0 | |
| 27 | ____.____ f9.4 Lower left longitude [DEG] | |
| 28 | ||
| 29 | 48.0 | |
| 30 | ____.____ f9.4 Lower left latitude [DEG] | |
| 31 | ||
| 32 | 15.0 | |
| 33 | ____.____ f9.4 Upper right longitude [DEG] | |
| 34 | ||
| 35 | 50.0 | |
| 36 | ____.____ f9.4 Upper right latitude [DEG] | |
| 37 | ||
| 38 | 0.5 | |
| 39 | ____.____ f9.4 DX: Longitudinal distance between trajectories [DEG] | |
| 40 | ||
| 41 | 0.5 | |
| 42 | ____.____ f9.4 DY: Latitudinal distance between trajectories [DEG] | |
| 43 | ||
| 44 | 5 | |
| 45 | _ 1X,I1 Kind of trajectory (see file header) | |
| 46 | ||
| 47 | 2 | |
| 48 | _ 1X,I1, Unit of z coordinate | |
| 49 | ||
| 50 | 2000.0 | |
| 51 | _____.___ f10.3 Lower z-coordinate (see file header) | |
| 52 | ||
| 53 | 3000.0 | |
| 54 | _____.___ f10.3 Upper z-coordinate (see file header) | |
| 55 | ||
| 56 | 500.0 | |
| 57 | _____.___ f10.3 DZ: Vertical interval of trajectories (see file header) | |
| 58 | ||
| 59 | TEST | |
| 60 | ________________________________________ character*40 comment | |
| 61 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * TRAJECTORY MODEL * | |
| 2 | * DEFINITION OF STARTING/ENDING POINTS IN FLIGHT MODE * | |
| 3 | * This file defines starting points separated non-uniformly in * | |
| 4 | * space as well as in time. Thus, both starting times AND starting * | |
| 5 | * coordinates must be given. * | |
| 6 | * The starting times must be strictly in temporal order. * | |
| 7 | * For backward trajectories, the temporal order must be reversed. * | |
| 8 | * In line #28 of this file, the name of the output file must be * | |
| 9 | * indicated. Lines #29 and #30 must contain kind of trajectory and * | |
| 10 | * the unit of the z coordinate to be used. Line #31 is arbitrary, * | |
| 11 | * then follows a sequence of points. * | |
| 12 | * Kind of trajectory: 1 = 3 dimensional * | |
| 13 | * 2 = on model layers * | |
| 14 | * 3 = mixing layer * | |
| 15 | * 4 = isobaric * | |
| 16 | * 5 = isentropic * | |
| 17 | ********************************************************************** | |
| 18 | * * | |
| 19 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 20 | * 2 = Meters above ground * | |
| 21 | * 3 = Hectopascal * | |
| 22 | * * | |
| 23 | * For mixing layer trajectories (kind 3), the z coordinate must be * | |
| 24 | * given in m.a.g.l. (option 2) * | |
| 25 | * * | |
| 26 | ********************************************************************** | |
| 27 | 'Flight#7' | |
| 28 | 1 I Kind of trajectory (see file header) | |
| 29 | 1 I Unit of z coordinate | |
| 30 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 31 | 19980404 000000 2I Starting date and time | |
| 32 | 34.0 F Longitude [DEG] | |
| 33 | 72.0 F Latitude [DEG] | |
| 34 | 1000.0 F z-coordinate (see file header) | |
| 35 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 36 | 19980404 140000 2I Starting date and time | |
| 37 | -15.0 F Longitude [DEG] | |
| 38 | 48.0 F Latitude [DEG] | |
| 39 | 2000.0 F z-coordinate (see file header) | |
| 40 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 41 | 19980405 130000 2I Starting date and time | |
| 42 | 10.0 F Longitude [DEG] | |
| 43 | 48.0 F Latitude [DEG] | |
| 44 | 3500.0 F z-coordinate (see file header) | |
| 45 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 46 | 19980406 130000 2I Starting date and time | |
| 47 | 10.0 F Longitude [DEG] | |
| 48 | 48.0 F Latitude [DEG] | |
| 49 | 3000.0 F z-coordinate (see file header) | |
| 50 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * TRAJECTORY MODEL * | |
| 2 | * DEFINITION OF STARTING/ENDING POINTS IN FLIGHT MODE * | |
| 3 | * This file defines starting points separated non-uniformly in * | |
| 4 | * space as well as in time. Thus, both starting times AND starting * | |
| 5 | * coordinates must be given. * | |
| 6 | * The starting times must be strictly in temporal order. * | |
| 7 | * For backward trajectories, the temporal order must be reversed. * | |
| 8 | * In line #28 of this file, the name of the output file must be * | |
| 9 | * indicated. Lines #29 and #30 must contain kind of trajectory and * | |
| 10 | * the unit of the z coordinate to be used. Line #31 is arbitrary, * | |
| 11 | * then follows a sequence of points. * | |
| 12 | * Kind of trajectory: 1 = 3 dimensional * | |
| 13 | * 2 = on model layers * | |
| 14 | * 3 = mixing layer * | |
| 15 | * 4 = isobaric * | |
| 16 | * 5 = isentropic * | |
| 17 | ********************************************************************** | |
| 18 | * * | |
| 19 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 20 | * 2 = Meters above ground * | |
| 21 | * 3 = Hectopascal * | |
| 22 | * * | |
| 23 | * For mixing layer trajectories (kind 3), the z coordinate must be * | |
| 24 | * given in m.a.g.l. (option 2) * | |
| 25 | * * | |
| 26 | ********************************************************************** | |
| 27 | 'Flight#7' | |
| 28 | 1 I Kind of trajectory (see file header) | |
| 29 | 1 I Unit of z coordinate | |
| 30 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 31 | 19980404 000000 2I Starting date and time | |
| 32 | 34.0 F Longitude [DEG] | |
| 33 | 72.0 F Latitude [DEG] | |
| 34 | 1000.0 F z-coordinate (see file header) | |
| 35 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 36 | 19980404 140000 2I Starting date and time | |
| 37 | -15.0 F Longitude [DEG] | |
| 38 | 48.0 F Latitude [DEG] | |
| 39 | 2000.0 F z-coordinate (see file header) | |
| 40 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 41 | 19980405 130000 2I Starting date and time | |
| 42 | 10.0 F Longitude [DEG] | |
| 43 | 48.0 F Latitude [DEG] | |
| 44 | 3500.0 F z-coordinate (see file header) | |
| 45 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 46 | 19980406 130000 2I Starting date and time | |
| 47 | 10.0 F Longitude [DEG] | |
| 48 | 48.0 F Latitude [DEG] | |
| 49 | 3000.0 F z-coordinate (see file header) | |
| 50 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF STARTING/ENDING POINTS * | |
| 4 | * * | |
| 5 | * The first 7 characters of the comment are also used as filenames. * | |
| 6 | * Therefore, they cannot be blank and they must be different for * | |
| 7 | * each starting point. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = mixing layer * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * For mixing layer trajectories (kind 3), the z coordinate must be * | |
| 22 | * given in m.a.g.l. (option 2) * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | 11.93 | |
| 27 | ____.____ f9.4 Longitude [DEG] | |
| 28 | ||
| 29 | 78.91 | |
| 30 | ____.____ f9.4 Latitude [DEG] | |
| 31 | ||
| 32 | 1 | |
| 33 | _ 1X,I1 Kind of trajectory (see file header) | |
| 34 | ||
| 35 | 1 | |
| 36 | _ 1X,I1, Unit of z coordinate | |
| 37 | ||
| 38 | 1500.00 | |
| 39 | _____.___ f10.3 z-coordinate (see file header) | |
| 40 | ||
| 41 | traj1 | |
| 42 | ________________________________________ character*40 comment | |
| 43 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 44 | 11.93 | |
| 45 | ____.____ f9.4 Longitude [DEG] | |
| 46 | ||
| 47 | 78.91 | |
| 48 | ____.____ f9.4 Latitude [DEG] | |
| 49 | ||
| 50 | 1 | |
| 51 | _ 1X,I1 Kind of trajectory (see file header) | |
| 52 | ||
| 53 | 1 | |
| 54 | _ 1X,I1, Unit of z coordinate | |
| 55 | ||
| 56 | 1600.00 | |
| 57 | _____.___ f10.3 z-coordinate (see file header) | |
| 58 | ||
| 59 | traj2 | |
| 60 | ________________________________________ character*40 comment | |
| 61 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 62 | 11.93 | |
| 63 | ____.____ f9.4 Longitude [DEG] | |
| 64 | ||
| 65 | 78.91 | |
| 66 | ____.____ f9.4 Latitude [DEG] | |
| 67 | ||
| 68 | 1 | |
| 69 | _ 1X,I1 Kind of trajectory (see file header) | |
| 70 | ||
| 71 | 1 | |
| 72 | _ 1X,I1, Unit of z coordinate | |
| 73 | ||
| 74 | 1700.00 | |
| 75 | _____.___ f10.3 z-coordinate (see file header) | |
| 76 | ||
| 77 | traj3 | |
| 78 | ________________________________________ character*40 comment | |
| 79 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 80 | 11.93 | |
| 81 | ____.____ f9.4 Longitude [DEG] | |
| 82 | ||
| 83 | 78.91 | |
| 84 | ____.____ f9.4 Latitude [DEG] | |
| 85 | ||
| 86 | 1 | |
| 87 | _ 1X,I1 Kind of trajectory (see file header) | |
| 88 | ||
| 89 | 1 | |
| 90 | _ 1X,I1, Unit of z coordinate | |
| 91 | ||
| 92 | 1800.00 | |
| 93 | _____.___ f10.3 z-coordinate (see file header) | |
| 94 | ||
| 95 | traj | |
| 96 | ________________________________________ character*40 comment | |
| 97 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 98 | 11.93 | |
| 99 | ____.____ f9.4 Longitude [DEG] | |
| 100 | ||
| 101 | 78.91 | |
| 102 | ____.____ f9.4 Latitude [DEG] | |
| 103 | ||
| 104 | 1 | |
| 105 | _ 1X,I1 Kind of trajectory (see file header) | |
| 106 | ||
| 107 | 1 | |
| 108 | _ 1X,I1, Unit of z coordinate | |
| 109 | ||
| 110 | 1900.00 | |
| 111 | _____.___ f10.3 z-coordinate (see file header) | |
| 112 | ||
| 113 | traj | |
| 114 | ________________________________________ character*40 comment | |
| 115 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 116 | 11.93 | |
| 117 | ____.____ f9.4 Longitude [DEG] | |
| 118 | ||
| 119 | 78.91 | |
| 120 | ____.____ f9.4 Latitude [DEG] | |
| 121 | ||
| 122 | 1 | |
| 123 | _ 1X,I1 Kind of trajectory (see file header) | |
| 124 | ||
| 125 | 1 | |
| 126 | _ 1X,I1, Unit of z coordinate | |
| 127 | ||
| 128 | 2000.00 | |
| 129 | _____.___ f10.3 z-coordinate (see file header) | |
| 130 | ||
| 131 | traj | |
| 132 | ________________________________________ character*40 comment | |
| 133 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 134 | 11.93 | |
| 135 | ____.____ f9.4 Longitude [DEG] | |
| 136 | ||
| 137 | 78.91 | |
| 138 | ____.____ f9.4 Latitude [DEG] | |
| 139 | ||
| 140 | 1 | |
| 141 | _ 1X,I1 Kind of trajectory (see file header) | |
| 142 | ||
| 143 | 1 | |
| 144 | _ 1X,I1, Unit of z coordinate | |
| 145 | ||
| 146 | 2100.00 | |
| 147 | _____.___ f10.3 z-coordinate (see file header) | |
| 148 | ||
| 149 | traj | |
| 150 | ________________________________________ character*40 comment | |
| 151 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 152 | 11.93 | |
| 153 | ____.____ f9.4 Longitude [DEG] | |
| 154 | ||
| 155 | 78.91 | |
| 156 | ____.____ f9.4 Latitude [DEG] | |
| 157 | ||
| 158 | 1 | |
| 159 | _ 1X,I1 Kind of trajectory (see file header) | |
| 160 | ||
| 161 | 1 | |
| 162 | _ 1X,I1, Unit of z coordinate | |
| 163 | ||
| 164 | 2200.00 | |
| 165 | _____.___ f10.3 z-coordinate (see file header) | |
| 166 | ||
| 167 | traj | |
| 168 | ________________________________________ character*40 comment | |
| 169 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 170 | 11.93 | |
| 171 | ____.____ f9.4 Longitude [DEG] | |
| 172 | ||
| 173 | 78.91 | |
| 174 | ____.____ f9.4 Latitude [DEG] | |
| 175 | ||
| 176 | 1 | |
| 177 | _ 1X,I1 Kind of trajectory (see file header) | |
| 178 | ||
| 179 | 1 | |
| 180 | _ 1X,I1, Unit of z coordinate | |
| 181 | ||
| 182 | 2300.00 | |
| 183 | _____.___ f10.3 z-coordinate (see file header) | |
| 184 | ||
| 185 | traj | |
| 186 | ________________________________________ character*40 comment | |
| 187 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 188 | 11.93 | |
| 189 | ____.____ f9.4 Longitude [DEG] | |
| 190 | ||
| 191 | 78.91 | |
| 192 | ____.____ f9.4 Latitude [DEG] | |
| 193 | ||
| 194 | 1 | |
| 195 | _ 1X,I1 Kind of trajectory (see file header) | |
| 196 | ||
| 197 | 1 | |
| 198 | _ 1X,I1, Unit of z coordinate | |
| 199 | ||
| 200 | 2400.00 | |
| 201 | _____.___ f10.3 z-coordinate (see file header) | |
| 202 | ||
| 203 | traj | |
| 204 | ________________________________________ character*40 comment | |
| 205 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 206 | 11.93 | |
| 207 | ____.____ f9.4 Longitude [DEG] | |
| 208 | ||
| 209 | 78.91 | |
| 210 | ____.____ f9.4 Latitude [DEG] | |
| 211 | ||
| 212 | 1 | |
| 213 | _ 1X,I1 Kind of trajectory (see file header) | |
| 214 | ||
| 215 | 1 | |
| 216 | _ 1X,I1, Unit of z coordinate | |
| 217 | ||
| 218 | 2500.00 | |
| 219 | _____.___ f10.3 z-coordinate (see file header) | |
| 220 | ||
| 221 | traj | |
| 222 | ________________________________________ character*40 comment | |
| 223 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF STARTING/ENDING POINTS * | |
| 4 | * * | |
| 5 | * The first 7 characters of the comment are also used as filenames. * | |
| 6 | * Therefore, they cannot be blank and they must be different for * | |
| 7 | * each starting point. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = mixing layer * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * For mixing layer trajectories (kind 3), the z coordinate must be * | |
| 22 | * given in m.a.g.l. (option 2) * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | 10.0 F Longitude [DEG] | |
| 27 | 48.0 F Latitude [DEG] | |
| 28 | 1 I Kind of trajectory (see file header) | |
| 29 | 1 I Unit of z coordinate | |
| 30 | 3000.0 F z-coordinate (see file header) | |
| 31 | 'TEST1' A Name of starting point | |
| 32 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 33 | -15.0 F Longitude [DEG] | |
| 34 | 48.0 F Latitude [DEG] | |
| 35 | 5 I Kind of trajectory (see file header) | |
| 36 | 2 I Unit of z coordinate | |
| 37 | 2000.0 F z-coordinate (see file header) | |
| 38 | 'TEST2' A Name of starting point | |
| 39 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF STARTING/ENDING POINTS * | |
| 4 | * * | |
| 5 | * The first 7 characters of the comment are also used as filenames. * | |
| 6 | * Therefore, they cannot be blank and they must be different for * | |
| 7 | * each starting point. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = mixing layer * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * For mixing layer trajectories (kind 3), the z coordinate must be * | |
| 22 | * given in m.a.g.l. (option 2) * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | 10.0 | |
| 27 | ____.____ f9.4 Longitude [DEG] | |
| 28 | ||
| 29 | 48.0 | |
| 30 | ____.____ f9.4 Latitude [DEG] | |
| 31 | ||
| 32 | 1 | |
| 33 | _ 1X,I1 Kind of trajectory (see file header) | |
| 34 | ||
| 35 | 1 | |
| 36 | _ 1X,I1, Unit of z coordinate | |
| 37 | ||
| 38 | 3000.0 | |
| 39 | _____.___ f10.3 z-coordinate (see file header) | |
| 40 | ||
| 41 | TEST1 | |
| 42 | ________________________________________ character*40 comment | |
| 43 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 44 | -15.0 | |
| 45 | ____.____ f9.4 Longitude [DEG] | |
| 46 | ||
| 47 | 48.0 | |
| 48 | ____.____ f9.4 Latitude [DEG] | |
| 49 | ||
| 50 | 5 | |
| 51 | _ 1X,I1 Kind of trajectory (see file header) | |
| 52 | ||
| 53 | 2 | |
| 54 | _ 1X,I1, Unit of z coordinate | |
| 55 | ||
| 56 | 2000.0 | |
| 57 | _____.___ f10.3 z-coordinate (see file header) | |
| 58 | ||
| 59 | TEST2 | |
| 60 | ________________________________________ character*40 comment | |
| 61 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF STARTING/ENDING POINTS * | |
| 4 | * * | |
| 5 | * The first 7 characters of the comment are also used as filenames. * | |
| 6 | * Therefore, they cannot be blank and they must be different for * | |
| 7 | * each starting point. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = mixing layer * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * For mixing layer trajectories (kind 3), the z coordinate must be * | |
| 22 | * given in m.a.g.l. (option 2) * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | 11.1 | |
| 27 | ____.____ f9.4 Longitude [DEG] | |
| 28 | ||
| 29 | 47.5 | |
| 30 | ____.____ f9.4 Latitude [DEG] | |
| 31 | ||
| 32 | 1 | |
| 33 | _ 1X,I1 Kind of trajectory (see file header) | |
| 34 | ||
| 35 | 2 | |
| 36 | _ 1X,I1, Unit of z coordinate | |
| 37 | ||
| 38 | 500.0 | |
| 39 | _____.___ f10.3 z-coordinate (see file header) | |
| 40 | ||
| 41 | 1 | |
| 42 | ________________________________________ character*40 comment | |
| 43 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 44 | 11.1 | |
| 45 | ____.____ f9.4 Longitude [DEG] | |
| 46 | ||
| 47 | 47.5 | |
| 48 | ____.____ f9.4 Latitude [DEG] | |
| 49 | ||
| 50 | 1 | |
| 51 | _ 1X,I1 Kind of trajectory (see file header) | |
| 52 | ||
| 53 | 2 | |
| 54 | _ 1X,I1, Unit of z coordinate | |
| 55 | ||
| 56 | 1000.0 | |
| 57 | _____.___ f10.3 z-coordinate (see file header) | |
| 58 | ||
| 59 | 1_0001 | |
| 60 | ________________________________________ character*40 comment | |
| 61 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 62 | 11.1 | |
| 63 | ____.____ f9.4 Longitude [DEG] | |
| 64 | ||
| 65 | 47.5 | |
| 66 | ____.____ f9.4 Latitude [DEG] | |
| 67 | ||
| 68 | 1 | |
| 69 | _ 1X,I1 Kind of trajectory (see file header) | |
| 70 | ||
| 71 | 2 | |
| 72 | _ 1X,I1, Unit of z coordinate | |
| 73 | ||
| 74 | 1500.0 | |
| 75 | _____.___ f10.3 z-coordinate (see file header) | |
| 76 | ||
| 77 | 1_0002 | |
| 78 | ________________________________________ character*40 comment | |
| 79 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 80 | 11.1 | |
| 81 | ____.____ f9.4 Longitude [DEG] | |
| 82 | ||
| 83 | 47.5 | |
| 84 | ____.____ f9.4 Latitude [DEG] | |
| 85 | ||
| 86 | 1 | |
| 87 | _ 1X,I1 Kind of trajectory (see file header) | |
| 88 | ||
| 89 | 2 | |
| 90 | _ 1X,I1, Unit of z coordinate | |
| 91 | ||
| 92 | 2000.0 | |
| 93 | _____.___ f10.3 z-coordinate (see file header) | |
| 94 | ||
| 95 | 1_0003 | |
| 96 | ________________________________________ character*40 comment | |
| 97 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 98 | 11.1 | |
| 99 | ____.____ f9.4 Longitude [DEG] | |
| 100 | ||
| 101 | 47.5 | |
| 102 | ____.____ f9.4 Latitude [DEG] | |
| 103 | ||
| 104 | 1 | |
| 105 | _ 1X,I1 Kind of trajectory (see file header) | |
| 106 | ||
| 107 | 2 | |
| 108 | _ 1X,I1, Unit of z coordinate | |
| 109 | ||
| 110 | 2500.0 | |
| 111 | _____.___ f10.3 z-coordinate (see file header) | |
| 112 | ||
| 113 | 1_0004 | |
| 114 | ________________________________________ character*40 comment | |
| 115 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 116 | 11.1 | |
| 117 | ____.____ f9.4 Longitude [DEG] | |
| 118 | ||
| 119 | 47.5 | |
| 120 | ____.____ f9.4 Latitude [DEG] | |
| 121 | ||
| 122 | 1 | |
| 123 | _ 1X,I1 Kind of trajectory (see file header) | |
| 124 | ||
| 125 | 2 | |
| 126 | _ 1X,I1, Unit of z coordinate | |
| 127 | ||
| 128 | 3000.0 | |
| 129 | _____.___ f10.3 z-coordinate (see file header) | |
| 130 | ||
| 131 | 1_0005 | |
| 132 | ________________________________________ character*40 comment | |
| 133 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 134 | 11.1 | |
| 135 | ____.____ f9.4 Longitude [DEG] | |
| 136 | ||
| 137 | 47.5 | |
| 138 | ____.____ f9.4 Latitude [DEG] | |
| 139 | ||
| 140 | 1 | |
| 141 | _ 1X,I1 Kind of trajectory (see file header) | |
| 142 | ||
| 143 | 2 | |
| 144 | _ 1X,I1, Unit of z coordinate | |
| 145 | ||
| 146 | 3500.0 | |
| 147 | _____.___ f10.3 z-coordinate (see file header) | |
| 148 | ||
| 149 | 1_0006 | |
| 150 | ________________________________________ character*40 comment | |
| 151 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 152 | 11.1 | |
| 153 | ____.____ f9.4 Longitude [DEG] | |
| 154 | ||
| 155 | 47.5 | |
| 156 | ____.____ f9.4 Latitude [DEG] | |
| 157 | ||
| 158 | 1 | |
| 159 | _ 1X,I1 Kind of trajectory (see file header) | |
| 160 | ||
| 161 | 2 | |
| 162 | _ 1X,I1, Unit of z coordinate | |
| 163 | ||
| 164 | 4000.0 | |
| 165 | _____.___ f10.3 z-coordinate (see file header) | |
| 166 | ||
| 167 | 1_0007 | |
| 168 | ________________________________________ character*40 comment | |
| 169 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 170 | 11.1 | |
| 171 | ____.____ f9.4 Longitude [DEG] | |
| 172 | ||
| 173 | 47.5 | |
| 174 | ____.____ f9.4 Latitude [DEG] | |
| 175 | ||
| 176 | 1 | |
| 177 | _ 1X,I1 Kind of trajectory (see file header) | |
| 178 | ||
| 179 | 2 | |
| 180 | _ 1X,I1, Unit of z coordinate | |
| 181 | ||
| 182 | 4500.0 | |
| 183 | _____.___ f10.3 z-coordinate (see file header) | |
| 184 | ||
| 185 | 1_0008 | |
| 186 | ________________________________________ character*40 comment | |
| 187 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 188 | 11.1 | |
| 189 | ____.____ f9.4 Longitude [DEG] | |
| 190 | ||
| 191 | 47.5 | |
| 192 | ____.____ f9.4 Latitude [DEG] | |
| 193 | ||
| 194 | 1 | |
| 195 | _ 1X,I1 Kind of trajectory (see file header) | |
| 196 | ||
| 197 | 2 | |
| 198 | _ 1X,I1, Unit of z coordinate | |
| 199 | ||
| 200 | 5000.0 | |
| 201 | _____.___ f10.3 z-coordinate (see file header) | |
| 202 | ||
| 203 | 1_0009 | |
| 204 | ________________________________________ character*40 comment | |
| 205 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 206 | 11.1 | |
| 207 | ____.____ f9.4 Longitude [DEG] | |
| 208 | ||
| 209 | 47.5 | |
| 210 | ____.____ f9.4 Latitude [DEG] | |
| 211 | ||
| 212 | 1 | |
| 213 | _ 1X,I1 Kind of trajectory (see file header) | |
| 214 | ||
| 215 | 2 | |
| 216 | _ 1X,I1, Unit of z coordinate | |
| 217 | ||
| 218 | 5500.0 | |
| 219 | _____.___ f10.3 z-coordinate (see file header) | |
| 220 | ||
| 221 | 1_0010 | |
| 222 | ________________________________________ character*40 comment | |
| 223 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 224 | 11.1 | |
| 225 | ____.____ f9.4 Longitude [DEG] | |
| 226 | ||
| 227 | 47.5 | |
| 228 | ____.____ f9.4 Latitude [DEG] | |
| 229 | ||
| 230 | 1 | |
| 231 | _ 1X,I1 Kind of trajectory (see file header) | |
| 232 | ||
| 233 | 2 | |
| 234 | _ 1X,I1, Unit of z coordinate | |
| 235 | ||
| 236 | 6000.0 | |
| 237 | _____.___ f10.3 z-coordinate (see file header) | |
| 238 | ||
| 239 | 1_0011 | |
| 240 | ________________________________________ character*40 comment | |
| 241 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 242 | 11.1 | |
| 243 | ____.____ f9.4 Longitude [DEG] | |
| 244 | ||
| 245 | 47.5 | |
| 246 | ____.____ f9.4 Latitude [DEG] | |
| 247 | ||
| 248 | 1 | |
| 249 | _ 1X,I1 Kind of trajectory (see file header) | |
| 250 | ||
| 251 | 2 | |
| 252 | _ 1X,I1, Unit of z coordinate | |
| 253 | ||
| 254 | 6500.0 | |
| 255 | _____.___ f10.3 z-coordinate (see file header) | |
| 256 | ||
| 257 | 1_0012 | |
| 258 | ________________________________________ character*40 comment | |
| 259 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 260 | 11.1 | |
| 261 | ____.____ f9.4 Longitude [DEG] | |
| 262 | ||
| 263 | 47.5 | |
| 264 | ____.____ f9.4 Latitude [DEG] | |
| 265 | ||
| 266 | 1 | |
| 267 | _ 1X,I1 Kind of trajectory (see file header) | |
| 268 | ||
| 269 | 2 | |
| 270 | _ 1X,I1, Unit of z coordinate | |
| 271 | ||
| 272 | 7000.0 | |
| 273 | _____.___ f10.3 z-coordinate (see file header) | |
| 274 | ||
| 275 | 1_0013 | |
| 276 | ________________________________________ character*40 comment | |
| 277 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 278 | 11.1 | |
| 279 | ____.____ f9.4 Longitude [DEG] | |
| 280 | ||
| 281 | 47.5 | |
| 282 | ____.____ f9.4 Latitude [DEG] | |
| 283 | ||
| 284 | 1 | |
| 285 | _ 1X,I1 Kind of trajectory (see file header) | |
| 286 | ||
| 287 | 2 | |
| 288 | _ 1X,I1, Unit of z coordinate | |
| 289 | ||
| 290 | 7500.0 | |
| 291 | _____.___ f10.3 z-coordinate (see file header) | |
| 292 | ||
| 293 | 1_0014 | |
| 294 | ________________________________________ character*40 comment | |
| 295 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 296 | 11.1 | |
| 297 | ____.____ f9.4 Longitude [DEG] | |
| 298 | ||
| 299 | 47.5 | |
| 300 | ____.____ f9.4 Latitude [DEG] | |
| 301 | ||
| 302 | 1 | |
| 303 | _ 1X,I1 Kind of trajectory (see file header) | |
| 304 | ||
| 305 | 2 | |
| 306 | _ 1X,I1, Unit of z coordinate | |
| 307 | ||
| 308 | 8000.0 | |
| 309 | _____.___ f10.3 z-coordinate (see file header) | |
| 310 | ||
| 311 | 1_0015 | |
| 312 | ________________________________________ character*40 comment | |
| 313 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 314 | 11.1 | |
| 315 | ____.____ f9.4 Longitude [DEG] | |
| 316 | ||
| 317 | 47.5 | |
| 318 | ____.____ f9.4 Latitude [DEG] | |
| 319 | ||
| 320 | 1 | |
| 321 | _ 1X,I1 Kind of trajectory (see file header) | |
| 322 | ||
| 323 | 2 | |
| 324 | _ 1X,I1, Unit of z coordinate | |
| 325 | ||
| 326 | 8500.0 | |
| 327 | _____.___ f10.3 z-coordinate (see file header) | |
| 328 | ||
| 329 | 1_0016 | |
| 330 | ________________________________________ character*40 comment | |
| 331 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 332 | 11.1 | |
| 333 | ____.____ f9.4 Longitude [DEG] | |
| 334 | ||
| 335 | 47.5 | |
| 336 | ____.____ f9.4 Latitude [DEG] | |
| 337 | ||
| 338 | 1 | |
| 339 | _ 1X,I1 Kind of trajectory (see file header) | |
| 340 | ||
| 341 | 2 | |
| 342 | _ 1X,I1, Unit of z coordinate | |
| 343 | ||
| 344 | 9000.0 | |
| 345 | _____.___ f10.3 z-coordinate (see file header) | |
| 346 | ||
| 347 | 1_0017 | |
| 348 | ________________________________________ character*40 comment | |
| 349 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 350 | 11.1 | |
| 351 | ____.____ f9.4 Longitude [DEG] | |
| 352 | ||
| 353 | 47.5 | |
| 354 | ____.____ f9.4 Latitude [DEG] | |
| 355 | ||
| 356 | 1 | |
| 357 | _ 1X,I1 Kind of trajectory (see file header) | |
| 358 | ||
| 359 | 2 | |
| 360 | _ 1X,I1, Unit of z coordinate | |
| 361 | ||
| 362 | 9500.0 | |
| 363 | _____.___ f10.3 z-coordinate (see file header) | |
| 364 | ||
| 365 | 1_0018 | |
| 366 | ________________________________________ character*40 comment | |
| 367 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 368 | 11.1 | |
| 369 | ____.____ f9.4 Longitude [DEG] | |
| 370 | ||
| 371 | 47.5 | |
| 372 | ____.____ f9.4 Latitude [DEG] | |
| 373 | ||
| 374 | 1 | |
| 375 | _ 1X,I1 Kind of trajectory (see file header) | |
| 376 | ||
| 377 | 2 | |
| 378 | _ 1X,I1, Unit of z coordinate | |
| 379 | ||
| 380 | 10000.0 | |
| 381 | _____.___ f10.3 z-coordinate (see file header) | |
| 382 | ||
| 383 | 1_0019 | |
| 384 | ________________________________________ character*40 comment | |
| 385 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 386 | 11.1 | |
| 387 | ____.____ f9.4 Longitude [DEG] | |
| 388 | ||
| 389 | 47.5 | |
| 390 | ____.____ f9.4 Latitude [DEG] | |
| 391 | ||
| 392 | 1 | |
| 393 | _ 1X,I1 Kind of trajectory (see file header) | |
| 394 | ||
| 395 | 2 | |
| 396 | _ 1X,I1, Unit of z coordinate | |
| 397 | ||
| 398 | 10500.0 | |
| 399 | _____.___ f10.3 z-coordinate (see file header) | |
| 400 | ||
| 401 | 1_0020 | |
| 402 | ________________________________________ character*40 comment | |
| 403 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 404 | 11.1 | |
| 405 | ____.____ f9.4 Longitude [DEG] | |
| 406 | ||
| 407 | 47.5 | |
| 408 | ____.____ f9.4 Latitude [DEG] | |
| 409 | ||
| 410 | 1 | |
| 411 | _ 1X,I1 Kind of trajectory (see file header) | |
| 412 | ||
| 413 | 2 | |
| 414 | _ 1X,I1, Unit of z coordinate | |
| 415 | ||
| 416 | 11000.0 | |
| 417 | _____.___ f10.3 z-coordinate (see file header) | |
| 418 | ||
| 419 | 1_0021 | |
| 420 | ________________________________________ character*40 comment | |
| 421 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 422 | 11.1 | |
| 423 | ____.____ f9.4 Longitude [DEG] | |
| 424 | ||
| 425 | 47.5 | |
| 426 | ____.____ f9.4 Latitude [DEG] | |
| 427 | ||
| 428 | 1 | |
| 429 | _ 1X,I1 Kind of trajectory (see file header) | |
| 430 | ||
| 431 | 2 | |
| 432 | _ 1X,I1, Unit of z coordinate | |
| 433 | ||
| 434 | 11500.0 | |
| 435 | _____.___ f10.3 z-coordinate (see file header) | |
| 436 | ||
| 437 | 1_0022 | |
| 438 | ________________________________________ character*40 comment | |
| 439 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 440 | 11.1 | |
| 441 | ____.____ f9.4 Longitude [DEG] | |
| 442 | ||
| 443 | 47.5 | |
| 444 | ____.____ f9.4 Latitude [DEG] | |
| 445 | ||
| 446 | 1 | |
| 447 | _ 1X,I1 Kind of trajectory (see file header) | |
| 448 | ||
| 449 | 2 | |
| 450 | _ 1X,I1, Unit of z coordinate | |
| 451 | ||
| 452 | 12000.0 | |
| 453 | _____.___ f10.3 z-coordinate (see file header) | |
| 454 | ||
| 455 | 1_0023 | |
| 456 | ________________________________________ character*40 comment | |
| 457 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 458 | -25.20 | |
| 459 | ____.____ f9.4 Longitude [DEG] | |
| 460 | ||
| 461 | 36.97 | |
| 462 | ____.____ f9.4 Latitude [DEG] | |
| 463 | ||
| 464 | 1 | |
| 465 | _ 1X,I1 Kind of trajectory (see file header) | |
| 466 | ||
| 467 | 1 | |
| 468 | _ 1X,I1, Unit of z coordinate | |
| 469 | ||
| 470 | 500.0 | |
| 471 | _____.___ f10.3 z-coordinate (see file header) | |
| 472 | ||
| 473 | 2 | |
| 474 | ________________________________________ character*40 comment | |
| 475 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 476 | -25.20 | |
| 477 | ____.____ f9.4 Longitude [DEG] | |
| 478 | ||
| 479 | 36.97 | |
| 480 | ____.____ f9.4 Latitude [DEG] | |
| 481 | ||
| 482 | 1 | |
| 483 | _ 1X,I1 Kind of trajectory (see file header) | |
| 484 | ||
| 485 | 1 | |
| 486 | _ 1X,I1, Unit of z coordinate | |
| 487 | ||
| 488 | 1000.0 | |
| 489 | _____.___ f10.3 z-coordinate (see file header) | |
| 490 | ||
| 491 | 2_0001 | |
| 492 | ________________________________________ character*40 comment | |
| 493 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 494 | -25.20 | |
| 495 | ____.____ f9.4 Longitude [DEG] | |
| 496 | ||
| 497 | 36.97 | |
| 498 | ____.____ f9.4 Latitude [DEG] | |
| 499 | ||
| 500 | 1 | |
| 501 | _ 1X,I1 Kind of trajectory (see file header) | |
| 502 | ||
| 503 | 1 | |
| 504 | _ 1X,I1, Unit of z coordinate | |
| 505 | ||
| 506 | 1500.0 | |
| 507 | _____.___ f10.3 z-coordinate (see file header) | |
| 508 | ||
| 509 | 2_0002 | |
| 510 | ________________________________________ character*40 comment | |
| 511 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 512 | -25.20 | |
| 513 | ____.____ f9.4 Longitude [DEG] | |
| 514 | ||
| 515 | 36.97 | |
| 516 | ____.____ f9.4 Latitude [DEG] | |
| 517 | ||
| 518 | 1 | |
| 519 | _ 1X,I1 Kind of trajectory (see file header) | |
| 520 | ||
| 521 | 1 | |
| 522 | _ 1X,I1, Unit of z coordinate | |
| 523 | ||
| 524 | 2000.0 | |
| 525 | _____.___ f10.3 z-coordinate (see file header) | |
| 526 | ||
| 527 | 2_0003 | |
| 528 | ________________________________________ character*40 comment | |
| 529 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 530 | -25.20 | |
| 531 | ____.____ f9.4 Longitude [DEG] | |
| 532 | ||
| 533 | 36.97 | |
| 534 | ____.____ f9.4 Latitude [DEG] | |
| 535 | ||
| 536 | 1 | |
| 537 | _ 1X,I1 Kind of trajectory (see file header) | |
| 538 | ||
| 539 | 1 | |
| 540 | _ 1X,I1, Unit of z coordinate | |
| 541 | ||
| 542 | 2500.0 | |
| 543 | _____.___ f10.3 z-coordinate (see file header) | |
| 544 | ||
| 545 | 2_0004 | |
| 546 | ________________________________________ character*40 comment | |
| 547 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 548 | -25.20 | |
| 549 | ____.____ f9.4 Longitude [DEG] | |
| 550 | ||
| 551 | 36.97 | |
| 552 | ____.____ f9.4 Latitude [DEG] | |
| 553 | ||
| 554 | 1 | |
| 555 | _ 1X,I1 Kind of trajectory (see file header) | |
| 556 | ||
| 557 | 1 | |
| 558 | _ 1X,I1, Unit of z coordinate | |
| 559 | ||
| 560 | 3000.0 | |
| 561 | _____.___ f10.3 z-coordinate (see file header) | |
| 562 | ||
| 563 | 2_0005 | |
| 564 | ________________________________________ character*40 comment | |
| 565 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 566 | -25.20 | |
| 567 | ____.____ f9.4 Longitude [DEG] | |
| 568 | ||
| 569 | 36.97 | |
| 570 | ____.____ f9.4 Latitude [DEG] | |
| 571 | ||
| 572 | 1 | |
| 573 | _ 1X,I1 Kind of trajectory (see file header) | |
| 574 | ||
| 575 | 1 | |
| 576 | _ 1X,I1, Unit of z coordinate | |
| 577 | ||
| 578 | 3500.0 | |
| 579 | _____.___ f10.3 z-coordinate (see file header) | |
| 580 | ||
| 581 | 2_0006 | |
| 582 | ________________________________________ character*40 comment | |
| 583 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 584 | -25.20 | |
| 585 | ____.____ f9.4 Longitude [DEG] | |
| 586 | ||
| 587 | 36.97 | |
| 588 | ____.____ f9.4 Latitude [DEG] | |
| 589 | ||
| 590 | 1 | |
| 591 | _ 1X,I1 Kind of trajectory (see file header) | |
| 592 | ||
| 593 | 1 | |
| 594 | _ 1X,I1, Unit of z coordinate | |
| 595 | ||
| 596 | 4000.0 | |
| 597 | _____.___ f10.3 z-coordinate (see file header) | |
| 598 | ||
| 599 | 2_0007 | |
| 600 | ________________________________________ character*40 comment | |
| 601 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 602 | -25.20 | |
| 603 | ____.____ f9.4 Longitude [DEG] | |
| 604 | ||
| 605 | 36.97 | |
| 606 | ____.____ f9.4 Latitude [DEG] | |
| 607 | ||
| 608 | 1 | |
| 609 | _ 1X,I1 Kind of trajectory (see file header) | |
| 610 | ||
| 611 | 1 | |
| 612 | _ 1X,I1, Unit of z coordinate | |
| 613 | ||
| 614 | 4500.0 | |
| 615 | _____.___ f10.3 z-coordinate (see file header) | |
| 616 | ||
| 617 | 2_0008 | |
| 618 | ________________________________________ character*40 comment | |
| 619 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 620 | -25.20 | |
| 621 | ____.____ f9.4 Longitude [DEG] | |
| 622 | ||
| 623 | 36.97 | |
| 624 | ____.____ f9.4 Latitude [DEG] | |
| 625 | ||
| 626 | 1 | |
| 627 | _ 1X,I1 Kind of trajectory (see file header) | |
| 628 | ||
| 629 | 1 | |
| 630 | _ 1X,I1, Unit of z coordinate | |
| 631 | ||
| 632 | 5000.0 | |
| 633 | _____.___ f10.3 z-coordinate (see file header) | |
| 634 | ||
| 635 | 2_0009 | |
| 636 | ________________________________________ character*40 comment | |
| 637 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 638 | -25.20 | |
| 639 | ____.____ f9.4 Longitude [DEG] | |
| 640 | ||
| 641 | 36.97 | |
| 642 | ____.____ f9.4 Latitude [DEG] | |
| 643 | ||
| 644 | 1 | |
| 645 | _ 1X,I1 Kind of trajectory (see file header) | |
| 646 | ||
| 647 | 1 | |
| 648 | _ 1X,I1, Unit of z coordinate | |
| 649 | ||
| 650 | 5500.0 | |
| 651 | _____.___ f10.3 z-coordinate (see file header) | |
| 652 | ||
| 653 | 2_0010 | |
| 654 | ________________________________________ character*40 comment | |
| 655 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 656 | -25.20 | |
| 657 | ____.____ f9.4 Longitude [DEG] | |
| 658 | ||
| 659 | 36.97 | |
| 660 | ____.____ f9.4 Latitude [DEG] | |
| 661 | ||
| 662 | 1 | |
| 663 | _ 1X,I1 Kind of trajectory (see file header) | |
| 664 | ||
| 665 | 1 | |
| 666 | _ 1X,I1, Unit of z coordinate | |
| 667 | ||
| 668 | 6000.0 | |
| 669 | _____.___ f10.3 z-coordinate (see file header) | |
| 670 | ||
| 671 | 2_0011 | |
| 672 | ________________________________________ character*40 comment | |
| 673 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 674 | -25.20 | |
| 675 | ____.____ f9.4 Longitude [DEG] | |
| 676 | ||
| 677 | 36.97 | |
| 678 | ____.____ f9.4 Latitude [DEG] | |
| 679 | ||
| 680 | 1 | |
| 681 | _ 1X,I1 Kind of trajectory (see file header) | |
| 682 | ||
| 683 | 1 | |
| 684 | _ 1X,I1, Unit of z coordinate | |
| 685 | ||
| 686 | 6500.0 | |
| 687 | _____.___ f10.3 z-coordinate (see file header) | |
| 688 | ||
| 689 | 2_0012 | |
| 690 | ________________________________________ character*40 comment | |
| 691 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 692 | -25.20 | |
| 693 | ____.____ f9.4 Longitude [DEG] | |
| 694 | ||
| 695 | 36.97 | |
| 696 | ____.____ f9.4 Latitude [DEG] | |
| 697 | ||
| 698 | 1 | |
| 699 | _ 1X,I1 Kind of trajectory (see file header) | |
| 700 | ||
| 701 | 1 | |
| 702 | _ 1X,I1, Unit of z coordinate | |
| 703 | ||
| 704 | 7000.0 | |
| 705 | _____.___ f10.3 z-coordinate (see file header) | |
| 706 | ||
| 707 | 2_0013 | |
| 708 | ________________________________________ character*40 comment | |
| 709 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 710 | -25.20 | |
| 711 | ____.____ f9.4 Longitude [DEG] | |
| 712 | ||
| 713 | 36.97 | |
| 714 | ____.____ f9.4 Latitude [DEG] | |
| 715 | ||
| 716 | 1 | |
| 717 | _ 1X,I1 Kind of trajectory (see file header) | |
| 718 | ||
| 719 | 1 | |
| 720 | _ 1X,I1, Unit of z coordinate | |
| 721 | ||
| 722 | 7500.0 | |
| 723 | _____.___ f10.3 z-coordinate (see file header) | |
| 724 | ||
| 725 | 2_0014 | |
| 726 | ________________________________________ character*40 comment | |
| 727 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 728 | -25.20 | |
| 729 | ____.____ f9.4 Longitude [DEG] | |
| 730 | ||
| 731 | 36.97 | |
| 732 | ____.____ f9.4 Latitude [DEG] | |
| 733 | ||
| 734 | 1 | |
| 735 | _ 1X,I1 Kind of trajectory (see file header) | |
| 736 | ||
| 737 | 1 | |
| 738 | _ 1X,I1, Unit of z coordinate | |
| 739 | ||
| 740 | 8000.0 | |
| 741 | _____.___ f10.3 z-coordinate (see file header) | |
| 742 | ||
| 743 | 2_0015 | |
| 744 | ________________________________________ character*40 comment | |
| 745 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 746 | -25.20 | |
| 747 | ____.____ f9.4 Longitude [DEG] | |
| 748 | ||
| 749 | 36.97 | |
| 750 | ____.____ f9.4 Latitude [DEG] | |
| 751 | ||
| 752 | 1 | |
| 753 | _ 1X,I1 Kind of trajectory (see file header) | |
| 754 | ||
| 755 | 1 | |
| 756 | _ 1X,I1, Unit of z coordinate | |
| 757 | ||
| 758 | 8500.0 | |
| 759 | _____.___ f10.3 z-coordinate (see file header) | |
| 760 | ||
| 761 | 2_0016 | |
| 762 | ________________________________________ character*40 comment | |
| 763 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 764 | -25.20 | |
| 765 | ____.____ f9.4 Longitude [DEG] | |
| 766 | ||
| 767 | 36.97 | |
| 768 | ____.____ f9.4 Latitude [DEG] | |
| 769 | ||
| 770 | 1 | |
| 771 | _ 1X,I1 Kind of trajectory (see file header) | |
| 772 | ||
| 773 | 1 | |
| 774 | _ 1X,I1, Unit of z coordinate | |
| 775 | ||
| 776 | 9000.0 | |
| 777 | _____.___ f10.3 z-coordinate (see file header) | |
| 778 | ||
| 779 | 2_0017 | |
| 780 | ________________________________________ character*40 comment | |
| 781 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 782 | -25.20 | |
| 783 | ____.____ f9.4 Longitude [DEG] | |
| 784 | ||
| 785 | 36.97 | |
| 786 | ____.____ f9.4 Latitude [DEG] | |
| 787 | ||
| 788 | 1 | |
| 789 | _ 1X,I1 Kind of trajectory (see file header) | |
| 790 | ||
| 791 | 1 | |
| 792 | _ 1X,I1, Unit of z coordinate | |
| 793 | ||
| 794 | 9500.0 | |
| 795 | _____.___ f10.3 z-coordinate (see file header) | |
| 796 | ||
| 797 | 2_0018 | |
| 798 | ________________________________________ character*40 comment | |
| 799 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 800 | -25.20 | |
| 801 | ____.____ f9.4 Longitude [DEG] | |
| 802 | ||
| 803 | 36.97 | |
| 804 | ____.____ f9.4 Latitude [DEG] | |
| 805 | ||
| 806 | 1 | |
| 807 | _ 1X,I1 Kind of trajectory (see file header) | |
| 808 | ||
| 809 | 1 | |
| 810 | _ 1X,I1, Unit of z coordinate | |
| 811 | ||
| 812 | 10000.0 | |
| 813 | _____.___ f10.3 z-coordinate (see file header) | |
| 814 | ||
| 815 | 2_0019 | |
| 816 | ________________________________________ character*40 comment | |
| 817 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 818 | -25.20 | |
| 819 | ____.____ f9.4 Longitude [DEG] | |
| 820 | ||
| 821 | 36.97 | |
| 822 | ____.____ f9.4 Latitude [DEG] | |
| 823 | ||
| 824 | 1 | |
| 825 | _ 1X,I1 Kind of trajectory (see file header) | |
| 826 | ||
| 827 | 1 | |
| 828 | _ 1X,I1, Unit of z coordinate | |
| 829 | ||
| 830 | 10500.0 | |
| 831 | _____.___ f10.3 z-coordinate (see file header) | |
| 832 | ||
| 833 | 2_0020 | |
| 834 | ________________________________________ character*40 comment | |
| 835 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 836 | -25.20 | |
| 837 | ____.____ f9.4 Longitude [DEG] | |
| 838 | ||
| 839 | 36.97 | |
| 840 | ____.____ f9.4 Latitude [DEG] | |
| 841 | ||
| 842 | 1 | |
| 843 | _ 1X,I1 Kind of trajectory (see file header) | |
| 844 | ||
| 845 | 1 | |
| 846 | _ 1X,I1, Unit of z coordinate | |
| 847 | ||
| 848 | 11000.0 | |
| 849 | _____.___ f10.3 z-coordinate (see file header) | |
| 850 | ||
| 851 | 2_0021 | |
| 852 | ________________________________________ character*40 comment | |
| 853 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 854 | -25.20 | |
| 855 | ____.____ f9.4 Longitude [DEG] | |
| 856 | ||
| 857 | 36.97 | |
| 858 | ____.____ f9.4 Latitude [DEG] | |
| 859 | ||
| 860 | 1 | |
| 861 | _ 1X,I1 Kind of trajectory (see file header) | |
| 862 | ||
| 863 | 1 | |
| 864 | _ 1X,I1, Unit of z coordinate | |
| 865 | ||
| 866 | 11500.0 | |
| 867 | _____.___ f10.3 z-coordinate (see file header) | |
| 868 | ||
| 869 | 2_0022 | |
| 870 | ________________________________________ character*40 comment | |
| 871 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 872 | -25.20 | |
| 873 | ____.____ f9.4 Longitude [DEG] | |
| 874 | ||
| 875 | 36.97 | |
| 876 | ____.____ f9.4 Latitude [DEG] | |
| 877 | ||
| 878 | 1 | |
| 879 | _ 1X,I1 Kind of trajectory (see file header) | |
| 880 | ||
| 881 | 1 | |
| 882 | _ 1X,I1, Unit of z coordinate | |
| 883 | ||
| 884 | 12000.0 | |
| 885 | _____.___ f10.3 z-coordinate (see file header) | |
| 886 | ||
| 887 | 2_0023 | |
| 888 | ________________________________________ character*40 comment | |
| 889 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | ********************************************************************** | |
| 1 | * * | |
| 2 | * TRAJECTORY MODEL * | |
| 3 | * DEFINITION OF STARTING/ENDING POINTS * | |
| 4 | * * | |
| 5 | * The first 7 characters of the comment are also used as filenames. * | |
| 6 | * Therefore, they cannot be blank and they must be different for * | |
| 7 | * each starting point. * | |
| 8 | * * | |
| 9 | * Kind of trajectory: 1 = 3 dimensional * | |
| 10 | * 2 = on model layers * | |
| 11 | * 3 = mixing layer * | |
| 12 | * 4 = isobaric * | |
| 13 | * 5 = isentropic * | |
| 14 | * * | |
| 15 | ********************************************************************** | |
| 16 | * * | |
| 17 | * Unit of z coordinate: 1 = Meters above sea level * | |
| 18 | * 2 = Meters above ground * | |
| 19 | * 3 = Hectopascal * | |
| 20 | * * | |
| 21 | * For mixing layer trajectories (kind 3), the z coordinate must be * | |
| 22 | * given in m.a.g.l. (option 2) * | |
| 23 | * * | |
| 24 | ********************************************************************** | |
| 25 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 26 | -69.99 | |
| 27 | ____.____ f9.4 Longitude [DEG] | |
| 28 | ||
| 29 | 41.69 | |
| 30 | ____.____ f9.4 Latitude [DEG] | |
| 31 | ||
| 32 | 1 | |
| 33 | _ 1X,I1 Kind of trajectory (see file header) | |
| 34 | ||
| 35 | 1 | |
| 36 | _ 1X,I1, Unit of z coordinate | |
| 37 | ||
| 38 | 500.0 | |
| 39 | _____.___ f10.3 z-coordinate (see file header) | |
| 40 | ||
| 41 | 3 | |
| 42 | ________________________________________ character*40 comment | |
| 43 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 44 | -69.99 | |
| 45 | ____.____ f9.4 Longitude [DEG] | |
| 46 | ||
| 47 | 41.69 | |
| 48 | ____.____ f9.4 Latitude [DEG] | |
| 49 | ||
| 50 | 1 | |
| 51 | _ 1X,I1 Kind of trajectory (see file header) | |
| 52 | ||
| 53 | 1 | |
| 54 | _ 1X,I1, Unit of z coordinate | |
| 55 | ||
| 56 | 1000.0 | |
| 57 | _____.___ f10.3 z-coordinate (see file header) | |
| 58 | ||
| 59 | 3_0001 | |
| 60 | ________________________________________ character*40 comment | |
| 61 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 62 | -69.99 | |
| 63 | ____.____ f9.4 Longitude [DEG] | |
| 64 | ||
| 65 | 41.69 | |
| 66 | ____.____ f9.4 Latitude [DEG] | |
| 67 | ||
| 68 | 1 | |
| 69 | _ 1X,I1 Kind of trajectory (see file header) | |
| 70 | ||
| 71 | 1 | |
| 72 | _ 1X,I1, Unit of z coordinate | |
| 73 | ||
| 74 | 1500.0 | |
| 75 | _____.___ f10.3 z-coordinate (see file header) | |
| 76 | ||
| 77 | 3_0002 | |
| 78 | ________________________________________ character*40 comment | |
| 79 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 80 | -69.99 | |
| 81 | ____.____ f9.4 Longitude [DEG] | |
| 82 | ||
| 83 | 41.69 | |
| 84 | ____.____ f9.4 Latitude [DEG] | |
| 85 | ||
| 86 | 1 | |
| 87 | _ 1X,I1 Kind of trajectory (see file header) | |
| 88 | ||
| 89 | 1 | |
| 90 | _ 1X,I1, Unit of z coordinate | |
| 91 | ||
| 92 | 2000.0 | |
| 93 | _____.___ f10.3 z-coordinate (see file header) | |
| 94 | ||
| 95 | 3_0003 | |
| 96 | ________________________________________ character*40 comment | |
| 97 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 98 | -69.99 | |
| 99 | ____.____ f9.4 Longitude [DEG] | |
| 100 | ||
| 101 | 41.69 | |
| 102 | ____.____ f9.4 Latitude [DEG] | |
| 103 | ||
| 104 | 1 | |
| 105 | _ 1X,I1 Kind of trajectory (see file header) | |
| 106 | ||
| 107 | 1 | |
| 108 | _ 1X,I1, Unit of z coordinate | |
| 109 | ||
| 110 | 2500.0 | |
| 111 | _____.___ f10.3 z-coordinate (see file header) | |
| 112 | ||
| 113 | 3_0004 | |
| 114 | ________________________________________ character*40 comment | |
| 115 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 116 | -69.99 | |
| 117 | ____.____ f9.4 Longitude [DEG] | |
| 118 | ||
| 119 | 41.69 | |
| 120 | ____.____ f9.4 Latitude [DEG] | |
| 121 | ||
| 122 | 1 | |
| 123 | _ 1X,I1 Kind of trajectory (see file header) | |
| 124 | ||
| 125 | 1 | |
| 126 | _ 1X,I1, Unit of z coordinate | |
| 127 | ||
| 128 | 3000.0 | |
| 129 | _____.___ f10.3 z-coordinate (see file header) | |
| 130 | ||
| 131 | 3_0005 | |
| 132 | ________________________________________ character*40 comment | |
| 133 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 134 | -69.99 | |
| 135 | ____.____ f9.4 Longitude [DEG] | |
| 136 | ||
| 137 | 41.69 | |
| 138 | ____.____ f9.4 Latitude [DEG] | |
| 139 | ||
| 140 | 1 | |
| 141 | _ 1X,I1 Kind of trajectory (see file header) | |
| 142 | ||
| 143 | 1 | |
| 144 | _ 1X,I1, Unit of z coordinate | |
| 145 | ||
| 146 | 3500.0 | |
| 147 | _____.___ f10.3 z-coordinate (see file header) | |
| 148 | ||
| 149 | 3_0006 | |
| 150 | ________________________________________ character*40 comment | |
| 151 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 152 | -69.99 | |
| 153 | ____.____ f9.4 Longitude [DEG] | |
| 154 | ||
| 155 | 41.69 | |
| 156 | ____.____ f9.4 Latitude [DEG] | |
| 157 | ||
| 158 | 1 | |
| 159 | _ 1X,I1 Kind of trajectory (see file header) | |
| 160 | ||
| 161 | 1 | |
| 162 | _ 1X,I1, Unit of z coordinate | |
| 163 | ||
| 164 | 4000.0 | |
| 165 | _____.___ f10.3 z-coordinate (see file header) | |
| 166 | ||
| 167 | 3_0007 | |
| 168 | ________________________________________ character*40 comment | |
| 169 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 170 | -69.99 | |
| 171 | ____.____ f9.4 Longitude [DEG] | |
| 172 | ||
| 173 | 41.69 | |
| 174 | ____.____ f9.4 Latitude [DEG] | |
| 175 | ||
| 176 | 1 | |
| 177 | _ 1X,I1 Kind of trajectory (see file header) | |
| 178 | ||
| 179 | 1 | |
| 180 | _ 1X,I1, Unit of z coordinate | |
| 181 | ||
| 182 | 4500.0 | |
| 183 | _____.___ f10.3 z-coordinate (see file header) | |
| 184 | ||
| 185 | 3_0008 | |
| 186 | ________________________________________ character*40 comment | |
| 187 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 188 | -69.99 | |
| 189 | ____.____ f9.4 Longitude [DEG] | |
| 190 | ||
| 191 | 41.69 | |
| 192 | ____.____ f9.4 Latitude [DEG] | |
| 193 | ||
| 194 | 1 | |
| 195 | _ 1X,I1 Kind of trajectory (see file header) | |
| 196 | ||
| 197 | 1 | |
| 198 | _ 1X,I1, Unit of z coordinate | |
| 199 | ||
| 200 | 5000.0 | |
| 201 | _____.___ f10.3 z-coordinate (see file header) | |
| 202 | ||
| 203 | 3_0009 | |
| 204 | ________________________________________ character*40 comment | |
| 205 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 206 | -69.99 | |
| 207 | ____.____ f9.4 Longitude [DEG] | |
| 208 | ||
| 209 | 41.69 | |
| 210 | ____.____ f9.4 Latitude [DEG] | |
| 211 | ||
| 212 | 1 | |
| 213 | _ 1X,I1 Kind of trajectory (see file header) | |
| 214 | ||
| 215 | 1 | |
| 216 | _ 1X,I1, Unit of z coordinate | |
| 217 | ||
| 218 | 5500.0 | |
| 219 | _____.___ f10.3 z-coordinate (see file header) | |
| 220 | ||
| 221 | 3_0010 | |
| 222 | ________________________________________ character*40 comment | |
| 223 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 224 | -69.99 | |
| 225 | ____.____ f9.4 Longitude [DEG] | |
| 226 | ||
| 227 | 41.69 | |
| 228 | ____.____ f9.4 Latitude [DEG] | |
| 229 | ||
| 230 | 1 | |
| 231 | _ 1X,I1 Kind of trajectory (see file header) | |
| 232 | ||
| 233 | 1 | |
| 234 | _ 1X,I1, Unit of z coordinate | |
| 235 | ||
| 236 | 6000.0 | |
| 237 | _____.___ f10.3 z-coordinate (see file header) | |
| 238 | ||
| 239 | 3_0011 | |
| 240 | ________________________________________ character*40 comment | |
| 241 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 242 | -69.99 | |
| 243 | ____.____ f9.4 Longitude [DEG] | |
| 244 | ||
| 245 | 41.69 | |
| 246 | ____.____ f9.4 Latitude [DEG] | |
| 247 | ||
| 248 | 1 | |
| 249 | _ 1X,I1 Kind of trajectory (see file header) | |
| 250 | ||
| 251 | 1 | |
| 252 | _ 1X,I1, Unit of z coordinate | |
| 253 | ||
| 254 | 6500.0 | |
| 255 | _____.___ f10.3 z-coordinate (see file header) | |
| 256 | ||
| 257 | 3_0012 | |
| 258 | ________________________________________ character*40 comment | |
| 259 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 260 | -69.99 | |
| 261 | ____.____ f9.4 Longitude [DEG] | |
| 262 | ||
| 263 | 41.69 | |
| 264 | ____.____ f9.4 Latitude [DEG] | |
| 265 | ||
| 266 | 1 | |
| 267 | _ 1X,I1 Kind of trajectory (see file header) | |
| 268 | ||
| 269 | 1 | |
| 270 | _ 1X,I1, Unit of z coordinate | |
| 271 | ||
| 272 | 7000.0 | |
| 273 | _____.___ f10.3 z-coordinate (see file header) | |
| 274 | ||
| 275 | 3_0013 | |
| 276 | ________________________________________ character*40 comment | |
| 277 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 278 | -69.99 | |
| 279 | ____.____ f9.4 Longitude [DEG] | |
| 280 | ||
| 281 | 41.69 | |
| 282 | ____.____ f9.4 Latitude [DEG] | |
| 283 | ||
| 284 | 1 | |
| 285 | _ 1X,I1 Kind of trajectory (see file header) | |
| 286 | ||
| 287 | 1 | |
| 288 | _ 1X,I1, Unit of z coordinate | |
| 289 | ||
| 290 | 7500.0 | |
| 291 | _____.___ f10.3 z-coordinate (see file header) | |
| 292 | ||
| 293 | 3_0014 | |
| 294 | ________________________________________ character*40 comment | |
| 295 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 296 | -69.99 | |
| 297 | ____.____ f9.4 Longitude [DEG] | |
| 298 | ||
| 299 | 41.69 | |
| 300 | ____.____ f9.4 Latitude [DEG] | |
| 301 | ||
| 302 | 1 | |
| 303 | _ 1X,I1 Kind of trajectory (see file header) | |
| 304 | ||
| 305 | 1 | |
| 306 | _ 1X,I1, Unit of z coordinate | |
| 307 | ||
| 308 | 8000.0 | |
| 309 | _____.___ f10.3 z-coordinate (see file header) | |
| 310 | ||
| 311 | 3_0015 | |
| 312 | ________________________________________ character*40 comment | |
| 313 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 314 | -69.99 | |
| 315 | ____.____ f9.4 Longitude [DEG] | |
| 316 | ||
| 317 | 41.69 | |
| 318 | ____.____ f9.4 Latitude [DEG] | |
| 319 | ||
| 320 | 1 | |
| 321 | _ 1X,I1 Kind of trajectory (see file header) | |
| 322 | ||
| 323 | 1 | |
| 324 | _ 1X,I1, Unit of z coordinate | |
| 325 | ||
| 326 | 8500.0 | |
| 327 | _____.___ f10.3 z-coordinate (see file header) | |
| 328 | ||
| 329 | 3_0016 | |
| 330 | ________________________________________ character*40 comment | |
| 331 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 332 | -69.99 | |
| 333 | ____.____ f9.4 Longitude [DEG] | |
| 334 | ||
| 335 | 41.69 | |
| 336 | ____.____ f9.4 Latitude [DEG] | |
| 337 | ||
| 338 | 1 | |
| 339 | _ 1X,I1 Kind of trajectory (see file header) | |
| 340 | ||
| 341 | 1 | |
| 342 | _ 1X,I1, Unit of z coordinate | |
| 343 | ||
| 344 | 9000.0 | |
| 345 | _____.___ f10.3 z-coordinate (see file header) | |
| 346 | ||
| 347 | 3_0017 | |
| 348 | ________________________________________ character*40 comment | |
| 349 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 350 | -69.99 | |
| 351 | ____.____ f9.4 Longitude [DEG] | |
| 352 | ||
| 353 | 41.69 | |
| 354 | ____.____ f9.4 Latitude [DEG] | |
| 355 | ||
| 356 | 1 | |
| 357 | _ 1X,I1 Kind of trajectory (see file header) | |
| 358 | ||
| 359 | 1 | |
| 360 | _ 1X,I1, Unit of z coordinate | |
| 361 | ||
| 362 | 9500.0 | |
| 363 | _____.___ f10.3 z-coordinate (see file header) | |
| 364 | ||
| 365 | 3_0018 | |
| 366 | ________________________________________ character*40 comment | |
| 367 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 368 | -69.99 | |
| 369 | ____.____ f9.4 Longitude [DEG] | |
| 370 | ||
| 371 | 41.69 | |
| 372 | ____.____ f9.4 Latitude [DEG] | |
| 373 | ||
| 374 | 1 | |
| 375 | _ 1X,I1 Kind of trajectory (see file header) | |
| 376 | ||
| 377 | 1 | |
| 378 | _ 1X,I1, Unit of z coordinate | |
| 379 | ||
| 380 | 10000.0 | |
| 381 | _____.___ f10.3 z-coordinate (see file header) | |
| 382 | ||
| 383 | 3_0019 | |
| 384 | ________________________________________ character*40 comment | |
| 385 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 386 | -69.99 | |
| 387 | ____.____ f9.4 Longitude [DEG] | |
| 388 | ||
| 389 | 41.69 | |
| 390 | ____.____ f9.4 Latitude [DEG] | |
| 391 | ||
| 392 | 1 | |
| 393 | _ 1X,I1 Kind of trajectory (see file header) | |
| 394 | ||
| 395 | 1 | |
| 396 | _ 1X,I1, Unit of z coordinate | |
| 397 | ||
| 398 | 10500.0 | |
| 399 | _____.___ f10.3 z-coordinate (see file header) | |
| 400 | ||
| 401 | 3_0020 | |
| 402 | ________________________________________ character*40 comment | |
| 403 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 404 | -69.99 | |
| 405 | ____.____ f9.4 Longitude [DEG] | |
| 406 | ||
| 407 | 41.69 | |
| 408 | ____.____ f9.4 Latitude [DEG] | |
| 409 | ||
| 410 | 1 | |
| 411 | _ 1X,I1 Kind of trajectory (see file header) | |
| 412 | ||
| 413 | 1 | |
| 414 | _ 1X,I1, Unit of z coordinate | |
| 415 | ||
| 416 | 11000.0 | |
| 417 | _____.___ f10.3 z-coordinate (see file header) | |
| 418 | ||
| 419 | 3_0021 | |
| 420 | ________________________________________ character*40 comment | |
| 421 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 422 | -69.99 | |
| 423 | ____.____ f9.4 Longitude [DEG] | |
| 424 | ||
| 425 | 41.69 | |
| 426 | ____.____ f9.4 Latitude [DEG] | |
| 427 | ||
| 428 | 1 | |
| 429 | _ 1X,I1 Kind of trajectory (see file header) | |
| 430 | ||
| 431 | 1 | |
| 432 | _ 1X,I1, Unit of z coordinate | |
| 433 | ||
| 434 | 11500.0 | |
| 435 | _____.___ f10.3 z-coordinate (see file header) | |
| 436 | ||
| 437 | 3_0022 | |
| 438 | ________________________________________ character*40 comment | |
| 439 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 440 | -69.99 | |
| 441 | ____.____ f9.4 Longitude [DEG] | |
| 442 | ||
| 443 | 41.69 | |
| 444 | ____.____ f9.4 Latitude [DEG] | |
| 445 | ||
| 446 | 1 | |
| 447 | _ 1X,I1 Kind of trajectory (see file header) | |
| 448 | ||
| 449 | 1 | |
| 450 | _ 1X,I1, Unit of z coordinate | |
| 451 | ||
| 452 | 12000.0 | |
| 453 | _____.___ f10.3 z-coordinate (see file header) | |
| 454 | ||
| 455 | 3_0023 | |
| 456 | ________________________________________ character*40 comment | |
| 457 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 458 | -72.30 | |
| 459 | ____.____ f9.4 Longitude [DEG] | |
| 460 | ||
| 461 | 41.15 | |
| 462 | ____.____ f9.4 Latitude [DEG] | |
| 463 | ||
| 464 | 1 | |
| 465 | _ 1X,I1 Kind of trajectory (see file header) | |
| 466 | ||
| 467 | 1 | |
| 468 | _ 1X,I1, Unit of z coordinate | |
| 469 | ||
| 470 | 500.0 | |
| 471 | _____.___ f10.3 z-coordinate (see file header) | |
| 472 | ||
| 473 | 4 | |
| 474 | ________________________________________ character*40 comment | |
| 475 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 476 | -72.30 | |
| 477 | ____.____ f9.4 Longitude [DEG] | |
| 478 | ||
| 479 | 41.15 | |
| 480 | ____.____ f9.4 Latitude [DEG] | |
| 481 | ||
| 482 | 1 | |
| 483 | _ 1X,I1 Kind of trajectory (see file header) | |
| 484 | ||
| 485 | 1 | |
| 486 | _ 1X,I1, Unit of z coordinate | |
| 487 | ||
| 488 | 1000.0 | |
| 489 | _____.___ f10.3 z-coordinate (see file header) | |
| 490 | ||
| 491 | 4_0001 | |
| 492 | ________________________________________ character*40 comment | |
| 493 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 494 | -72.30 | |
| 495 | ____.____ f9.4 Longitude [DEG] | |
| 496 | ||
| 497 | 41.15 | |
| 498 | ____.____ f9.4 Latitude [DEG] | |
| 499 | ||
| 500 | 1 | |
| 501 | _ 1X,I1 Kind of trajectory (see file header) | |
| 502 | ||
| 503 | 1 | |
| 504 | _ 1X,I1, Unit of z coordinate | |
| 505 | ||
| 506 | 1500.0 | |
| 507 | _____.___ f10.3 z-coordinate (see file header) | |
| 508 | ||
| 509 | 4_0002 | |
| 510 | ________________________________________ character*40 comment | |
| 511 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 512 | -72.30 | |
| 513 | ____.____ f9.4 Longitude [DEG] | |
| 514 | ||
| 515 | 41.15 | |
| 516 | ____.____ f9.4 Latitude [DEG] | |
| 517 | ||
| 518 | 1 | |
| 519 | _ 1X,I1 Kind of trajectory (see file header) | |
| 520 | ||
| 521 | 1 | |
| 522 | _ 1X,I1, Unit of z coordinate | |
| 523 | ||
| 524 | 2000.0 | |
| 525 | _____.___ f10.3 z-coordinate (see file header) | |
| 526 | ||
| 527 | 4_0003 | |
| 528 | ________________________________________ character*40 comment | |
| 529 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 530 | -72.30 | |
| 531 | ____.____ f9.4 Longitude [DEG] | |
| 532 | ||
| 533 | 41.15 | |
| 534 | ____.____ f9.4 Latitude [DEG] | |
| 535 | ||
| 536 | 1 | |
| 537 | _ 1X,I1 Kind of trajectory (see file header) | |
| 538 | ||
| 539 | 1 | |
| 540 | _ 1X,I1, Unit of z coordinate | |
| 541 | ||
| 542 | 2500.0 | |
| 543 | _____.___ f10.3 z-coordinate (see file header) | |
| 544 | ||
| 545 | 4_0004 | |
| 546 | ________________________________________ character*40 comment | |
| 547 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 548 | -72.30 | |
| 549 | ____.____ f9.4 Longitude [DEG] | |
| 550 | ||
| 551 | 41.15 | |
| 552 | ____.____ f9.4 Latitude [DEG] | |
| 553 | ||
| 554 | 1 | |
| 555 | _ 1X,I1 Kind of trajectory (see file header) | |
| 556 | ||
| 557 | 1 | |
| 558 | _ 1X,I1, Unit of z coordinate | |
| 559 | ||
| 560 | 3000.0 | |
| 561 | _____.___ f10.3 z-coordinate (see file header) | |
| 562 | ||
| 563 | 4_0005 | |
| 564 | ________________________________________ character*40 comment | |
| 565 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 566 | -72.30 | |
| 567 | ____.____ f9.4 Longitude [DEG] | |
| 568 | ||
| 569 | 41.15 | |
| 570 | ____.____ f9.4 Latitude [DEG] | |
| 571 | ||
| 572 | 1 | |
| 573 | _ 1X,I1 Kind of trajectory (see file header) | |
| 574 | ||
| 575 | 1 | |
| 576 | _ 1X,I1, Unit of z coordinate | |
| 577 | ||
| 578 | 3500.0 | |
| 579 | _____.___ f10.3 z-coordinate (see file header) | |
| 580 | ||
| 581 | 4_0006 | |
| 582 | ________________________________________ character*40 comment | |
| 583 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 584 | -72.30 | |
| 585 | ____.____ f9.4 Longitude [DEG] | |
| 586 | ||
| 587 | 41.15 | |
| 588 | ____.____ f9.4 Latitude [DEG] | |
| 589 | ||
| 590 | 1 | |
| 591 | _ 1X,I1 Kind of trajectory (see file header) | |
| 592 | ||
| 593 | 1 | |
| 594 | _ 1X,I1, Unit of z coordinate | |
| 595 | ||
| 596 | 4000.0 | |
| 597 | _____.___ f10.3 z-coordinate (see file header) | |
| 598 | ||
| 599 | 4_0007 | |
| 600 | ________________________________________ character*40 comment | |
| 601 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 602 | -72.30 | |
| 603 | ____.____ f9.4 Longitude [DEG] | |
| 604 | ||
| 605 | 41.15 | |
| 606 | ____.____ f9.4 Latitude [DEG] | |
| 607 | ||
| 608 | 1 | |
| 609 | _ 1X,I1 Kind of trajectory (see file header) | |
| 610 | ||
| 611 | 1 | |
| 612 | _ 1X,I1, Unit of z coordinate | |
| 613 | ||
| 614 | 4500.0 | |
| 615 | _____.___ f10.3 z-coordinate (see file header) | |
| 616 | ||
| 617 | 4_0008 | |
| 618 | ________________________________________ character*40 comment | |
| 619 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 620 | -72.30 | |
| 621 | ____.____ f9.4 Longitude [DEG] | |
| 622 | ||
| 623 | 41.15 | |
| 624 | ____.____ f9.4 Latitude [DEG] | |
| 625 | ||
| 626 | 1 | |
| 627 | _ 1X,I1 Kind of trajectory (see file header) | |
| 628 | ||
| 629 | 1 | |
| 630 | _ 1X,I1, Unit of z coordinate | |
| 631 | ||
| 632 | 5000.0 | |
| 633 | _____.___ f10.3 z-coordinate (see file header) | |
| 634 | ||
| 635 | 4_0009 | |
| 636 | ________________________________________ character*40 comment | |
| 637 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 638 | -72.30 | |
| 639 | ____.____ f9.4 Longitude [DEG] | |
| 640 | ||
| 641 | 41.15 | |
| 642 | ____.____ f9.4 Latitude [DEG] | |
| 643 | ||
| 644 | 1 | |
| 645 | _ 1X,I1 Kind of trajectory (see file header) | |
| 646 | ||
| 647 | 1 | |
| 648 | _ 1X,I1, Unit of z coordinate | |
| 649 | ||
| 650 | 5500.0 | |
| 651 | _____.___ f10.3 z-coordinate (see file header) | |
| 652 | ||
| 653 | 4_0010 | |
| 654 | ________________________________________ character*40 comment | |
| 655 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 656 | -72.30 | |
| 657 | ____.____ f9.4 Longitude [DEG] | |
| 658 | ||
| 659 | 41.15 | |
| 660 | ____.____ f9.4 Latitude [DEG] | |
| 661 | ||
| 662 | 1 | |
| 663 | _ 1X,I1 Kind of trajectory (see file header) | |
| 664 | ||
| 665 | 1 | |
| 666 | _ 1X,I1, Unit of z coordinate | |
| 667 | ||
| 668 | 6000.0 | |
| 669 | _____.___ f10.3 z-coordinate (see file header) | |
| 670 | ||
| 671 | 4_0011 | |
| 672 | ________________________________________ character*40 comment | |
| 673 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 674 | -72.30 | |
| 675 | ____.____ f9.4 Longitude [DEG] | |
| 676 | ||
| 677 | 41.15 | |
| 678 | ____.____ f9.4 Latitude [DEG] | |
| 679 | ||
| 680 | 1 | |
| 681 | _ 1X,I1 Kind of trajectory (see file header) | |
| 682 | ||
| 683 | 1 | |
| 684 | _ 1X,I1, Unit of z coordinate | |
| 685 | ||
| 686 | 6500.0 | |
| 687 | _____.___ f10.3 z-coordinate (see file header) | |
| 688 | ||
| 689 | 4_0012 | |
| 690 | ________________________________________ character*40 comment | |
| 691 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 692 | -72.30 | |
| 693 | ____.____ f9.4 Longitude [DEG] | |
| 694 | ||
| 695 | 41.15 | |
| 696 | ____.____ f9.4 Latitude [DEG] | |
| 697 | ||
| 698 | 1 | |
| 699 | _ 1X,I1 Kind of trajectory (see file header) | |
| 700 | ||
| 701 | 1 | |
| 702 | _ 1X,I1, Unit of z coordinate | |
| 703 | ||
| 704 | 7000.0 | |
| 705 | _____.___ f10.3 z-coordinate (see file header) | |
| 706 | ||
| 707 | 4_0013 | |
| 708 | ________________________________________ character*40 comment | |
| 709 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 710 | -72.30 | |
| 711 | ____.____ f9.4 Longitude [DEG] | |
| 712 | ||
| 713 | 41.15 | |
| 714 | ____.____ f9.4 Latitude [DEG] | |
| 715 | ||
| 716 | 1 | |
| 717 | _ 1X,I1 Kind of trajectory (see file header) | |
| 718 | ||
| 719 | 1 | |
| 720 | _ 1X,I1, Unit of z coordinate | |
| 721 | ||
| 722 | 7500.0 | |
| 723 | _____.___ f10.3 z-coordinate (see file header) | |
| 724 | ||
| 725 | 4_0014 | |
| 726 | ________________________________________ character*40 comment | |
| 727 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 728 | -72.30 | |
| 729 | ____.____ f9.4 Longitude [DEG] | |
| 730 | ||
| 731 | 41.15 | |
| 732 | ____.____ f9.4 Latitude [DEG] | |
| 733 | ||
| 734 | 1 | |
| 735 | _ 1X,I1 Kind of trajectory (see file header) | |
| 736 | ||
| 737 | 1 | |
| 738 | _ 1X,I1, Unit of z coordinate | |
| 739 | ||
| 740 | 8000.0 | |
| 741 | _____.___ f10.3 z-coordinate (see file header) | |
| 742 | ||
| 743 | 4_0015 | |
| 744 | ________________________________________ character*40 comment | |
| 745 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 746 | -72.30 | |
| 747 | ____.____ f9.4 Longitude [DEG] | |
| 748 | ||
| 749 | 41.15 | |
| 750 | ____.____ f9.4 Latitude [DEG] | |
| 751 | ||
| 752 | 1 | |
| 753 | _ 1X,I1 Kind of trajectory (see file header) | |
| 754 | ||
| 755 | 1 | |
| 756 | _ 1X,I1, Unit of z coordinate | |
| 757 | ||
| 758 | 8500.0 | |
| 759 | _____.___ f10.3 z-coordinate (see file header) | |
| 760 | ||
| 761 | 4_0016 | |
| 762 | ________________________________________ character*40 comment | |
| 763 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 764 | -72.30 | |
| 765 | ____.____ f9.4 Longitude [DEG] | |
| 766 | ||
| 767 | 41.15 | |
| 768 | ____.____ f9.4 Latitude [DEG] | |
| 769 | ||
| 770 | 1 | |
| 771 | _ 1X,I1 Kind of trajectory (see file header) | |
| 772 | ||
| 773 | 1 | |
| 774 | _ 1X,I1, Unit of z coordinate | |
| 775 | ||
| 776 | 9000.0 | |
| 777 | _____.___ f10.3 z-coordinate (see file header) | |
| 778 | ||
| 779 | 4_0017 | |
| 780 | ________________________________________ character*40 comment | |
| 781 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 782 | -72.30 | |
| 783 | ____.____ f9.4 Longitude [DEG] | |
| 784 | ||
| 785 | 41.15 | |
| 786 | ____.____ f9.4 Latitude [DEG] | |
| 787 | ||
| 788 | 1 | |
| 789 | _ 1X,I1 Kind of trajectory (see file header) | |
| 790 | ||
| 791 | 1 | |
| 792 | _ 1X,I1, Unit of z coordinate | |
| 793 | ||
| 794 | 9500.0 | |
| 795 | _____.___ f10.3 z-coordinate (see file header) | |
| 796 | ||
| 797 | 4_0018 | |
| 798 | ________________________________________ character*40 comment | |
| 799 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 800 | -72.30 | |
| 801 | ____.____ f9.4 Longitude [DEG] | |
| 802 | ||
| 803 | 41.15 | |
| 804 | ____.____ f9.4 Latitude [DEG] | |
| 805 | ||
| 806 | 1 | |
| 807 | _ 1X,I1 Kind of trajectory (see file header) | |
| 808 | ||
| 809 | 1 | |
| 810 | _ 1X,I1, Unit of z coordinate | |
| 811 | ||
| 812 | 10000.0 | |
| 813 | _____.___ f10.3 z-coordinate (see file header) | |
| 814 | ||
| 815 | 4_0019 | |
| 816 | ________________________________________ character*40 comment | |
| 817 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 818 | -72.30 | |
| 819 | ____.____ f9.4 Longitude [DEG] | |
| 820 | ||
| 821 | 41.15 | |
| 822 | ____.____ f9.4 Latitude [DEG] | |
| 823 | ||
| 824 | 1 | |
| 825 | _ 1X,I1 Kind of trajectory (see file header) | |
| 826 | ||
| 827 | 1 | |
| 828 | _ 1X,I1, Unit of z coordinate | |
| 829 | ||
| 830 | 10500.0 | |
| 831 | _____.___ f10.3 z-coordinate (see file header) | |
| 832 | ||
| 833 | 4_0020 | |
| 834 | ________________________________________ character*40 comment | |
| 835 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 836 | -72.30 | |
| 837 | ____.____ f9.4 Longitude [DEG] | |
| 838 | ||
| 839 | 41.15 | |
| 840 | ____.____ f9.4 Latitude [DEG] | |
| 841 | ||
| 842 | 1 | |
| 843 | _ 1X,I1 Kind of trajectory (see file header) | |
| 844 | ||
| 845 | 1 | |
| 846 | _ 1X,I1, Unit of z coordinate | |
| 847 | ||
| 848 | 11000.0 | |
| 849 | _____.___ f10.3 z-coordinate (see file header) | |
| 850 | ||
| 851 | 4_0021 | |
| 852 | ________________________________________ character*40 comment | |
| 853 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 854 | -72.30 | |
| 855 | ____.____ f9.4 Longitude [DEG] | |
| 856 | ||
| 857 | 41.15 | |
| 858 | ____.____ f9.4 Latitude [DEG] | |
| 859 | ||
| 860 | 1 | |
| 861 | _ 1X,I1 Kind of trajectory (see file header) | |
| 862 | ||
| 863 | 1 | |
| 864 | _ 1X,I1, Unit of z coordinate | |
| 865 | ||
| 866 | 11500.0 | |
| 867 | _____.___ f10.3 z-coordinate (see file header) | |
| 868 | ||
| 869 | 4_0022 | |
| 870 | ________________________________________ character*40 comment | |
| 871 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ | |
| 872 | -72.30 | |
| 873 | ____.____ f9.4 Longitude [DEG] | |
| 874 | ||
| 875 | 41.15 | |
| 876 | ____.____ f9.4 Latitude [DEG] | |
| 877 | ||
| 878 | 1 | |
| 879 | _ 1X,I1 Kind of trajectory (see file header) | |
| 880 | ||
| 881 | 1 | |
| 882 | _ 1X,I1, Unit of z coordinate | |
| 883 | ||
| 884 | 12000.0 | |
| 885 | _____.___ f10.3 z-coordinate (see file header) | |
| 886 | ||
| 887 | 4_0023 | |
| 888 | ________________________________________ character*40 comment | |
| 889 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| 0 | subroutine orolininterpol(yy,nxmax,nymax,nx,ny,xt,yt,yint) | |
| 1 | C i i i i i i i o | |
| 2 | ***************************************************************************** | |
| 3 | * * | |
| 4 | * Interpolation of meteorological fields on 2-d model layers. * | |
| 5 | * A bilinear interpolation interpolation is used. * | |
| 6 | * * | |
| 7 | * * | |
| 8 | * Author: A. Stohl * | |
| 9 | * * | |
| 10 | * 30 May 1994 * | |
| 11 | * * | |
| 12 | ***************************************************************************** | |
| 13 | * * | |
| 14 | * Variables: * | |
| 15 | * * | |
| 16 | * height(nzmax) heights of the model levels * | |
| 17 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 18 | * nx,ny actual field dimensions in x,y and z direction * | |
| 19 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 20 | * xt current x coordinate * | |
| 21 | * yint the final interpolated value * | |
| 22 | * yt current y coordinate * | |
| 23 | * yy(0:nxmax-1,0:nymax-1) meteorological field used for interpolation * | |
| 24 | * zt current z coordinate * | |
| 25 | * * | |
| 26 | ***************************************************************************** | |
| 27 | ||
| 28 | implicit none | |
| 29 | ||
| 30 | integer nx,ny,nxmax,nymax,ix,jy,ixp,jyp | |
| 31 | real yy(0:nxmax-1,0:nymax-1) | |
| 32 | real ddx,ddy,rddx,rddy | |
| 33 | real xt,yt,yint | |
| 34 | ||
| 35 | ||
| 36 | ||
| 37 | C If point at border of grid -> small displacement into grid | |
| 38 | ************************************************************ | |
| 39 | ||
| 40 | if (xt.ge.float(nx-1)) xt=float(nx-1)-0.00001 | |
| 41 | if (yt.ge.float(ny-1)) yt=float(ny-1)-0.00001 | |
| 42 | ||
| 43 | ||
| 44 | ||
| 45 | *********************************************************************** | |
| 46 | C 1.) Bilinear horizontal interpolation | |
| 47 | C This has to be done separately for 2 fields (Temporal) | |
| 48 | ******************************************************** | |
| 49 | ||
| 50 | C Determine the lower left corner and its distance to the current position | |
| 51 | ************************************************************************** | |
| 52 | ||
| 53 | ix=int(xt) | |
| 54 | jy=int(yt) | |
| 55 | ixp=ix+1 | |
| 56 | jyp=jy+1 | |
| 57 | ddx=xt-float(ix) | |
| 58 | ddy=yt-float(jy) | |
| 59 | rddx=1.-ddx | |
| 60 | rddy=1.-ddy | |
| 61 | ||
| 62 | ||
| 63 | C Loop over 2 time steps | |
| 64 | ************************ | |
| 65 | ||
| 66 | yint=rddx*rddy*yy(ix ,jy ) | |
| 67 | + + ddx*rddy*yy(ixp,jy ) | |
| 68 | + +rddx* ddy*yy(ix ,jyp) | |
| 69 | + + ddx* ddy*yy(ixp,jyp) | |
| 70 | ||
| 71 | ||
| 72 | ||
| 73 | return | |
| 74 | end |
| 0 | subroutine orolininterpoln(yy,maxnests,nxmax,nymax,ngrid,nxn,nyn, | |
| 1 | +xt,yt,yint) | |
| 2 | C i i i i i i i | |
| 3 | C i i o | |
| 4 | ***************************************************************************** | |
| 5 | * * | |
| 6 | * Interpolation of nested meteorological fields on 2-d model layers. * | |
| 7 | * A bilinear interpolation interpolation is used. * | |
| 8 | * * | |
| 9 | * * | |
| 10 | * Author: A. Stohl * | |
| 11 | * * | |
| 12 | * 30 May 1994 * | |
| 13 | * * | |
| 14 | ***************************************************************************** | |
| 15 | * * | |
| 16 | * Variables: * | |
| 17 | * * | |
| 18 | * height(nzmax) heights of the model levels * | |
| 19 | * ix,jy x,y coordinates of lower left subgrid point * | |
| 20 | * maxnests maximum allowed number of nests * | |
| 21 | * ngrid currently used number of nests * | |
| 22 | * nxn,nyn actual field dimensions in x,y and z direction * | |
| 23 | * nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * | |
| 24 | * xt current x coordinate * | |
| 25 | * yint the final interpolated value * | |
| 26 | * yt current y coordinate * | |
| 27 | * yy(0:nxmax-1,0:nymax-1) meteorological field used for interpolation * | |
| 28 | * zt current z coordinate * | |
| 29 | * * | |
| 30 | ***************************************************************************** | |
| 31 | ||
| 32 | implicit none | |
| 33 | ||
| 34 | integer maxnests,nxn(maxnests),nyn(maxnests),nxmax,nymax,ngrid | |
| 35 | integer ix,jy,ixp,jyp | |
| 36 | real yy(0:nxmax-1,0:nymax-1,maxnests) | |
| 37 | real ddx,ddy,rddx,rddy | |
| 38 | real xt,yt,yint | |
| 39 | ||
| 40 | ||
| 41 | ||
| 42 | C If point at border of grid -> small displacement into grid | |
| 43 | ************************************************************ | |
| 44 | ||
| 45 | if (xt.ge.float(nxn(ngrid)-1)) xt=float(nxn(ngrid)-1)-0.00001 | |
| 46 | if (yt.ge.float(nyn(ngrid)-1)) yt=float(nyn(ngrid)-1)-0.00001 | |
| 47 | ||
| 48 | ||
| 49 | ||
| 50 | *********************************************************************** | |
| 51 | C 1.) Bilinear horizontal interpolation | |
| 52 | C This has to be done separately for 2 fields (Temporal) | |
| 53 | ******************************************************** | |
| 54 | ||
| 55 | C Determine the lower left corner and its distance to the current position | |
| 56 | ************************************************************************** | |
| 57 | ||
| 58 | ix=int(xt) | |
| 59 | jy=int(yt) | |
| 60 | ixp=ix+1 | |
| 61 | jyp=jy+1 | |
| 62 | ddx=xt-float(ix) | |
| 63 | ddy=yt-float(jy) | |
| 64 | rddx=1.-ddx | |
| 65 | rddy=1.-ddy | |
| 66 | ||
| 67 | ||
| 68 | C Loop over 2 time steps | |
| 69 | ************************ | |
| 70 | ||
| 71 | yint=rddx*rddy*yy(ix ,jy ,ngrid) | |
| 72 | + + ddx*rddy*yy(ixp,jy ,ngrid) | |
| 73 | + +rddx* ddy*yy(ix ,jyp,ngrid) | |
| 74 | + + ddx* ddy*yy(ixp,jyp,ngrid) | |
| 75 | ||
| 76 | ||
| 77 | ||
| 78 | return | |
| 79 | end |
| 0 | subroutine petters(minstep,nt,itime,xold,yold,zold,pold,hold, | |
| 1 | +qqold,pvold,thold,xnew,ynew,znew,pnew,hnew,qqnew,pvnew,thnew, | |
| 2 | +ntstep,nstop,levconst,init,lkind,lkindz,unc,trerroru, | |
| 3 | +trerrorv,trerrorw) | |
| 4 | C i i i i i i o o | |
| 5 | C o o o o o o o o o o o | |
| 6 | C o o i i i i i o | |
| 7 | C o o | |
| 8 | ******************************************************************************** | |
| 9 | * * | |
| 10 | * Calculation of trajectories utilizing the Petterssen scheme. * | |
| 11 | * The time step is determined by the Courant-Friedrichs-Lewy (CFL) criterion. * | |
| 12 | * This means that the time step must be so small that the displacement within * | |
| 13 | * this time step is smaller than 1 grid distance. Additionally, a temporal * | |
| 14 | * CFL criterion is introduced: the time step must be smaller than the time * | |
| 15 | * interval of the wind fields used for interpolation. * | |
| 16 | * The CFL criterion is only used for the initialization of the iteration * | |
| 17 | * scheme. Within the Petterssen iteration scheme this time step is not * | |
| 18 | * corrected, but kept constant. * | |
| 19 | * * | |
| 20 | * Author: A. Stohl * | |
| 21 | * * | |
| 22 | * 1 February 1994 * | |
| 23 | * * | |
| 24 | * Update: 16 February 1997: limitation of the estimated truncation error * | |
| 25 | * * | |
| 26 | * Update: 29 July 1998: use of global data * | |
| 27 | * * | |
| 28 | * Literature: * | |
| 29 | * Petterssen (1940): Weather Analysis and Forecasting. McGraw-Hill Book * | |
| 30 | * Company, Inc. * | |
| 31 | * Seibert P. (1993): Convergence and Accuracy of Numerical Methods for * | |
| 32 | * Trajectory Calculation. J. Appl. Met. 32, 558-566. * | |
| 33 | * * | |
| 34 | ******************************************************************************** | |
| 35 | * * | |
| 36 | * Variables: * | |
| 37 | * corr correlation coefficient of random errors * | |
| 38 | * epsu,epsv,epsw magnitude of random errors for uncertainty trajecories * | |
| 39 | * idiff [s] Temporal distance between the windfields used for interpol* | |
| 40 | * init .true. for first time step of trajectory * | |
| 41 | * indwz index of the model layer beneath current position of traj.* | |
| 42 | * itermax maximum number of iterations used in the integration schem* | |
| 43 | * itime [s] current temporal position * | |
| 44 | * ldirect Temporal direction of trajectories (-1=backward,1=forward)* | |
| 45 | * levconst height of trajectory in Pa, m or K depending on type of t.* | |
| 46 | * lkind kind of trajectory (e.g. isobaric, 3-dimensional) * | |
| 47 | * lkindz unit of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 48 | * minstep [s] minimum possible time step=not to exceed dimension maxtime* | |
| 49 | * ngrid index which grid is to be used * | |
| 50 | * nstop =greater 0, if trajectory calculation is finished * | |
| 51 | * nt [s] Current age of trajectory * | |
| 52 | * ntstep final time step of trajectory calculation * | |
| 53 | * ntstep1 time step determined by horizontal CFL-criterion * | |
| 54 | * ntstep2 time step determined by vertical CFL-criterion * | |
| 55 | * ntstep3 time step determined by temporal CFL-criterion * | |
| 56 | * pnew,hnew height at next time steps position in pressure and z coor * | |
| 57 | * pold,hold height at current time steps position in p and z coordina * | |
| 58 | * pvold,pvnew [Ks-1Pa-1] potential vorticity at old and new position * | |
| 59 | * qqold,qqnew specific humidity at old and new position * | |
| 60 | * thold,thnew potential temperature at old and new position * | |
| 61 | * trerroru, trerrorv, trerrorw memory of random errors added at last timestep* | |
| 62 | * unew,vnew,wnew Wind components at next time steps position of trajectory * | |
| 63 | * uold,vold,wold Wind components at current position of trajectory * | |
| 64 | * vvmax maximum of u and v, help variable * | |
| 65 | * wheight(nwzmax) Heights of the model layers for w component * | |
| 66 | * xhelp,yhelp,zhelp help variables * | |
| 67 | * xnew,ynew,znew Next time step's spatial position of trajectory * | |
| 68 | * xold,yold,zold Actual spatial position of trajectory * | |
| 69 | * zdist vertical grid distance at current position of trajectory * | |
| 70 | * * | |
| 71 | * Constants: * | |
| 72 | * cfl factor, by which the time step has to be smaller than the * | |
| 73 | * spatial CFL-criterion * | |
| 74 | * cflt factor, by which the time step has to be smaller than the * | |
| 75 | * temporal CFL-criterion * | |
| 76 | * deltahormax maximum horizontal distance between two iterations * | |
| 77 | * deltavermax maximum vertical distance between two iterations * | |
| 78 | * eps1 tiny number * | |
| 79 | * itermax maximum number of iterations * | |
| 80 | * * | |
| 81 | ******************************************************************************** | |
| 82 | ||
| 83 | include 'includepar' | |
| 84 | include 'includecom' | |
| 85 | ||
| 86 | integer i,j,nt,itime,nstop,idiff,indwz,ntstep,ntstep1,ntstep2 | |
| 87 | integer ntstep3,minstep,lkind,lkindz,idummy,ngrid | |
| 88 | real xold,yold,zold,xnew,ynew,znew,xhelp,yhelp,zhelp,uint,vint | |
| 89 | real unew,vnew,wnew,uold,vold,wold,vvmax,zdist,levconst | |
| 90 | real pold,hold,pnew,hnew,pvold,pvnew,thold,thnew,qqold,qqnew | |
| 91 | real gasdev,xlon,ylat,xpol,ypol,gridsize | |
| 92 | real cgszll,xpolold,ypolold,corr,trerroru,trerrorv,trerrorw | |
| 93 | logical init,unc | |
| 94 | save idummy | |
| 95 | data idummy/-7/ | |
| 96 | ||
| 97 | nstop=0 | |
| 98 | ntstep=0 | |
| 99 | ||
| 100 | C Determine whether lat/long grid or polarstereographic projection | |
| 101 | C is to be used | |
| 102 | C Furthermore, determine which nesting level to be used | |
| 103 | ****************************************************************** | |
| 104 | c write (*,*) 'petters',nglobal,yold,switchnorthg | |
| 105 | if (nglobal.and.(yold.gt.switchnorthg)) then | |
| 106 | ngrid=-1 | |
| 107 | else if (sglobal.and.(yold.lt.switchsouthg)) then | |
| 108 | ngrid=-2 | |
| 109 | else | |
| 110 | ngrid=0 | |
| 111 | do 12 j=numbnests,1,-1 | |
| 112 | if ((xold.gt.xln(j)).and.(xold.lt.xrn(j)).and. | |
| 113 | + (yold.gt.yln(j)).and.(yold.lt.yrn(j))) then | |
| 114 | ngrid=j | |
| 115 | goto 13 | |
| 116 | endif | |
| 117 | 12 continue | |
| 118 | 13 continue | |
| 119 | endif | |
| 120 | ||
| 121 | ||
| 122 | C Get wind data at the current trajectory position | |
| 123 | ************************************************** | |
| 124 | ||
| 125 | call getwind(.true.,init,itime,levconst,xold,yold,zold,lkind, | |
| 126 | +lkindz,2,ngrid,uint,vint,wold,idiff,indwz,nstop) | |
| 127 | ||
| 128 | if (nstop.gt.1) return | |
| 129 | ||
| 130 | C Transformation m/s --> grid units/time unit | |
| 131 | ********************************************* | |
| 132 | ||
| 133 | if (ngrid.ge.0) then ! mother domain | |
| 134 | call utransform(uint,yold,uold) | |
| 135 | call vtransform(vint,vold) | |
| 136 | else if (ngrid.eq.-1) then ! around north pole | |
| 137 | xlon=xlon0+xold*dx | |
| 138 | ylat=ylat0+yold*dy | |
| 139 | gridsize=1000.*cgszll(northpolemap,ylat,xlon) | |
| 140 | uold=uint/gridsize | |
| 141 | vold=vint/gridsize | |
| 142 | else if (ngrid.eq.-2) then ! around south pole | |
| 143 | xlon=xlon0+xold*dx | |
| 144 | ylat=ylat0+yold*dy | |
| 145 | gridsize=1000.*cgszll(southpolemap,ylat,xlon) | |
| 146 | uold=uint/gridsize | |
| 147 | vold=vint/gridsize | |
| 148 | endif | |
| 149 | ||
| 150 | ||
| 151 | ||
| 152 | C Calculate the time step determined by the CFL criterion | |
| 153 | C Three independent CFL-criteria are used: | |
| 154 | C 1) In horizontal direction = displacement smaller than grid distance | |
| 155 | C 2) In vertical direction = displacement smaller than grid distance | |
| 156 | C 3) In temporal direction = distance between the 2 windfields used for interpol | |
| 157 | C The final time step is the minimum of 1,2 and 3 | |
| 158 | ******************************************************************************** | |
| 159 | ||
| 160 | if (ngrid.lt.0) then | |
| 161 | ntstep1=999999 | |
| 162 | else | |
| 163 | vvmax=max(abs(uold)*xresoln(ngrid),abs(vold)*yresoln(ngrid),eps1) | |
| 164 | ntstep1=int(min(1./vvmax/cfl,999999.)) ! 1 | |
| 165 | endif | |
| 166 | ||
| 167 | if (lkind.eq.1) then | |
| 168 | zdist=wheight(indwz+1)-wheight(indwz) | |
| 169 | if (abs(wold).lt.eps1) wold=eps1 | |
| 170 | ntstep2=int(min(zdist/abs(wold)/cfl,999999.)) ! 2 | |
| 171 | else | |
| 172 | ntstep2=999999 | |
| 173 | endif | |
| 174 | ||
| 175 | ntstep3=int(float(idiff)/cflt) ! 3 | |
| 176 | ||
| 177 | ntstep=min(ntstep1,ntstep2,ntstep3) | |
| 178 | ||
| 179 | if (ntstep.lt.1) ntstep=1 ! minimum step = 1 second | |
| 180 | ||
| 181 | ||
| 182 | C Check, if such a short time step is possible. Under the assumption | |
| 183 | C that all following time steps have the same length, check if this | |
| 184 | C would lead to an exceedance of field dimensions. If this is the case | |
| 185 | C increase the time step. However the time step cannot be greater than | |
| 186 | C the time difference between 2 wind fields | |
| 187 | ********************************************************************** | |
| 188 | ||
| 189 | if ((inter.ne.1).and.(ntstep.lt.minstep)) then | |
| 190 | ntstep=min(minstep,idiff) | |
| 191 | write(*,*) 'Warning: time step exceeds CFL-criterion!' | |
| 192 | endif | |
| 193 | ||
| 194 | if (ldirect.eq.-1) ntstep=-1*ntstep ! backward t. -> negative | |
| 195 | ||
| 196 | ||
| 197 | C If the last step of trajectory is reached, give nstop code 1 | |
| 198 | C Reduce the time step, so that trajectory ends exactly after lentra seconds | |
| 199 | **************************************************************************** | |
| 200 | ||
| 201 | if (abs(nt+ntstep).ge.abs(lentra)) then | |
| 202 | ntstep=ldirect*(abs(lentra-nt)) | |
| 203 | nstop=1 | |
| 204 | endif | |
| 205 | ||
| 206 | ||
| 207 | C Calculate first guess position at time step nt+ntstep | |
| 208 | ******************************************************* | |
| 209 | ||
| 210 | if (ngrid.ge.0) then ! mother domain | |
| 211 | xnew=xold+uold*float(ntstep) | |
| 212 | ynew=yold+vold*float(ntstep) | |
| 213 | else if (ngrid.eq.-1) then ! around north pole | |
| 214 | call cll2xy(northpolemap,ylat,xlon,xpolold,ypolold) | |
| 215 | xpol=xpolold+uold*float(ntstep) | |
| 216 | ypol=ypolold+vold*float(ntstep) | |
| 217 | call cxy2ll(northpolemap,xpol,ypol,ylat,xlon) | |
| 218 | xnew=(xlon-xlon0)/dx | |
| 219 | ynew=(ylat-ylat0)/dy | |
| 220 | else if (ngrid.eq.-2) then ! around south pole | |
| 221 | call cll2xy(southpolemap,ylat,xlon,xpolold,ypolold) | |
| 222 | xpol=xpolold+uold*float(ntstep) | |
| 223 | ypol=ypolold+vold*float(ntstep) | |
| 224 | call cxy2ll(southpolemap,xpol,ypol,ylat,xlon) | |
| 225 | xnew=(xlon-xlon0)/dx | |
| 226 | ynew=(ylat-ylat0)/dy | |
| 227 | endif | |
| 228 | if(lkind.eq.1) then | |
| 229 | znew=zold+wold*float(ntstep) | |
| 230 | else | |
| 231 | znew=zold | |
| 232 | endif | |
| 233 | ||
| 234 | ||
| 235 | C Check position: If trajectory outside model domain, terminate it | |
| 236 | ****************************************************************** | |
| 237 | ||
| 238 | if (znew.gt.heightmax) znew=heightmax | |
| 239 | if (znew.lt.heightmin) znew=heightmin | |
| 240 | ||
| 241 | ||
| 242 | C If global data are available, use cyclic boundary condition | |
| 243 | ************************************************************* | |
| 244 | ||
| 245 | if (xglobal) then | |
| 246 | if (xnew.gt.float(nx-1)) xnew=xnew-float(nx-1) | |
| 247 | if (xnew.lt.0.) xnew=xnew+float(nx-1) | |
| 248 | endif | |
| 249 | ||
| 250 | ||
| 251 | if ((xnew.lt.0.).or.(xnew.gt.float(nx-1)).or.(ynew.lt.0.).or. | |
| 252 | +(ynew.gt.float(ny-1))) then | |
| 253 | nstop=2 | |
| 254 | return | |
| 255 | endif | |
| 256 | ||
| 257 | ||
| 258 | C Iteration. A maximum of itermax iterations is allowed. Iteration is | |
| 259 | C terminated, when distance between two iterations is less than the maximum | |
| 260 | C allowable distance deltadistmax | |
| 261 | *************************************************************************** | |
| 262 | ||
| 263 | do 10 i=1,itermax | |
| 264 | xhelp=xnew | |
| 265 | yhelp=ynew | |
| 266 | zhelp=znew | |
| 267 | ||
| 268 | C Check whether position is within a nest | |
| 269 | ***************************************** | |
| 270 | ||
| 271 | if (ngrid.ge.0) then | |
| 272 | ngrid=0 | |
| 273 | do 22 j=numbnests,1,-1 | |
| 274 | if ((xnew.gt.xln(j)).and.(xnew.lt.xrn(j)).and. | |
| 275 | + (ynew.gt.yln(j)).and.(ynew.lt.yrn(j))) then | |
| 276 | ngrid=j | |
| 277 | goto 23 | |
| 278 | endif | |
| 279 | 22 continue | |
| 280 | 23 continue | |
| 281 | endif | |
| 282 | ||
| 283 | C Get wind data at trajectory position at time step nt+ntstep | |
| 284 | ************************************************************* | |
| 285 | ||
| 286 | call getwind(.false.,init,itime+ntstep,levconst,xnew,ynew, | |
| 287 | + znew,lkind,lkindz,i,ngrid,uint,vint,wnew,idiff,indwz,nstop) | |
| 288 | ||
| 289 | if (nstop.gt.1) return | |
| 290 | ||
| 291 | C Transformation m/s --> grid units/time unit and advection | |
| 292 | *********************************************************** | |
| 293 | ||
| 294 | if (ngrid.ge.0) then | |
| 295 | call utransform(uint,ynew,unew) | |
| 296 | call vtransform(vint,vnew) | |
| 297 | xnew=xold+(uold+unew)*float(ntstep)/2. | |
| 298 | ynew=yold+(vold+vnew)*float(ntstep)/2. | |
| 299 | else if (ngrid.eq.-1) then ! around north pole | |
| 300 | xlon=xlon0+xnew*dx | |
| 301 | ylat=ylat0+ynew*dy | |
| 302 | gridsize=1000.*cgszll(northpolemap,ylat,xlon) | |
| 303 | unew=uint/gridsize | |
| 304 | vnew=vint/gridsize | |
| 305 | xpol=xpolold+(uold+unew)*float(ntstep)/2. | |
| 306 | ypol=ypolold+(vold+vnew)*float(ntstep)/2. | |
| 307 | call cxy2ll(northpolemap,xpol,ypol,ylat,xlon) | |
| 308 | xnew=(xlon-xlon0)/dx | |
| 309 | ynew=(ylat-ylat0)/dy | |
| 310 | else if (ngrid.eq.-2) then ! around south pole | |
| 311 | xlon=xlon0+xnew*dx | |
| 312 | ylat=ylat0+ynew*dy | |
| 313 | gridsize=1000.*cgszll(southpolemap,ylat,xlon) | |
| 314 | unew=uint/gridsize | |
| 315 | vnew=vint/gridsize | |
| 316 | xpol=xpolold+(uold+unew)*float(ntstep)/2. | |
| 317 | ypol=ypolold+(vold+vnew)*float(ntstep)/2. | |
| 318 | call cxy2ll(southpolemap,xpol,ypol,ylat,xlon) | |
| 319 | xnew=(xlon-xlon0)/dx | |
| 320 | ynew=(ylat-ylat0)/dy | |
| 321 | endif | |
| 322 | ||
| 323 | if(lkind.eq.1) then | |
| 324 | znew=zold+(wold+wnew)*float(ntstep)/2. | |
| 325 | endif | |
| 326 | ||
| 327 | C Check position: If trajectory outside model domain, terminate it | |
| 328 | ****************************************************************** | |
| 329 | ||
| 330 | if (znew.gt.heightmax) znew=heightmax | |
| 331 | if (znew.lt.heightmin) znew=heightmin | |
| 332 | ||
| 333 | ||
| 334 | C If global data are available, use cyclic boundary condition | |
| 335 | ************************************************************* | |
| 336 | ||
| 337 | if (xglobal) then | |
| 338 | if (xnew.gt.float(nx-1)) xnew=xnew-float(nx-1) | |
| 339 | if (xnew.lt.0.) xnew=xnew+float(nx-1) | |
| 340 | endif | |
| 341 | ||
| 342 | ||
| 343 | if ((xnew.lt.0.).or.(xnew.gt.float(nx-1)).or.(ynew.lt.0.).or. | |
| 344 | + (ynew.gt.float(ny-1))) then | |
| 345 | nstop=2 | |
| 346 | return | |
| 347 | endif | |
| 348 | ||
| 349 | ||
| 350 | ||
| 351 | C If the distance between two iterations is less than the maximum allowable | |
| 352 | C one (in vertical and horizontal direction), leave the loop. | |
| 353 | *************************************************************************** | |
| 354 | ||
| 355 | if (lkind.eq.1) then | |
| 356 | if ((sqrt((xhelp-xnew)*(xhelp-xnew)+(yhelp-ynew)*(yhelp-ynew)) | |
| 357 | + .lt.deltahormax).and. | |
| 358 | + (abs(zhelp-znew).lt.deltavermax*zdist)) goto 20 | |
| 359 | else | |
| 360 | if (sqrt((xhelp-xnew)*(xhelp-xnew)+(yhelp-ynew)*(yhelp-ynew)) | |
| 361 | + .lt.deltahormax) goto 20 | |
| 362 | endif | |
| 363 | ||
| 364 | 10 continue | |
| 365 | ||
| 366 | 20 continue | |
| 367 | ||
| 368 | ||
| 369 | C Calculate random displacement for uncertainty trajectories | |
| 370 | C using a Langevin equation | |
| 371 | C For this, an autocorrelation of wind errors is calculated. | |
| 372 | C This is not done near the poles! | |
| 373 | ************************************************************ | |
| 374 | ||
| 375 | if (unc.and.(ngrid.ge.0)) then | |
| 376 | corr=exp(-1./(relaxtime*max(cfl,cflt))) | |
| 377 | trerroru=corr*trerroru+gasdev(idummy)*epsu*sqrt(1.-corr**2) | |
| 378 | xnew=xnew+trerroru*(uold+unew)*float(ntstep)/2. | |
| 379 | trerrorv=corr*trerrorv+gasdev(idummy)*epsv*sqrt(1.-corr**2) | |
| 380 | ynew=ynew+trerrorv*(vold+vnew)*float(ntstep)/2. | |
| 381 | trerrorw=corr*trerrorw+gasdev(idummy)*epsw*sqrt(1.-corr**2) | |
| 382 | znew=znew+trerrorw*(wold+wnew)*float(ntstep)/2. | |
| 383 | if (xglobal) then | |
| 384 | if (xnew.gt.float(nx-1)) xnew=xnew-float(nx-1) | |
| 385 | if (xnew.lt.0.) xnew=xnew+float(nx-1) | |
| 386 | endif | |
| 387 | if ((xnew.lt.0.).or.(xnew.gt.float(nx-1)).or.(ynew.lt.0.).or. | |
| 388 | + (ynew.gt.float(ny-1))) then | |
| 389 | nstop=2 | |
| 390 | return | |
| 391 | endif | |
| 392 | if (znew.gt.heightmax) znew=heightmax | |
| 393 | if (znew.lt.heightmin) znew=heightmin | |
| 394 | endif | |
| 395 | ||
| 396 | ||
| 397 | ||
| 398 | C Calculate vertical position of trajectory in pressure and z coordinates. | |
| 399 | C Interpolate also additional meteo data (PV, THETA, Spec. Hum.) to | |
| 400 | C trajectory position. | |
| 401 | C This is always done for the new positions, only for the first position | |
| 402 | C of the trajectory it is necessary to calculate the old positions. | |
| 403 | ************************************************************************* | |
| 404 | ||
| 405 | if (init) then | |
| 406 | call getheight(itime,xold,yold,zold,pold,hold) | |
| 407 | call getmet(itime,xold,yold,zold,qqold,pvold,thold) | |
| 408 | endif | |
| 409 | call getheight(itime+ntstep,xnew,ynew,znew,pnew,hnew) | |
| 410 | call getmet(itime+ntstep,xnew,ynew,znew,qqnew,pvnew,thnew) | |
| 411 | ||
| 412 | return | |
| 413 | end |
| 0 | real function pp(psurf,eta) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE PP * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1994-04-07 * | |
| 9 | * LAST UPDATE: ---------- * | |
| 10 | * * | |
| 11 | *********************************************************************** | |
| 12 | * * | |
| 13 | * DESCRIPTION: This function computes the pressure as a function of * | |
| 14 | * eta (ECMWF) and surface pressure. The interpolation * | |
| 15 | * between the nearest model layers is performed linear * | |
| 16 | * * | |
| 17 | *********************************************************************** | |
| 18 | * * | |
| 19 | * INPUT: * | |
| 20 | * * | |
| 21 | * psurf surface pressure [Pa] * | |
| 22 | * eta vertical coordinate eta (ECMWF) * | |
| 23 | * * | |
| 24 | *********************************************************************** | |
| 25 | * * | |
| 26 | * OUTPUT: * | |
| 27 | * * | |
| 28 | * pp pressure [Pa] * | |
| 29 | * * | |
| 30 | *********************************************************************** | |
| 31 | * | |
| 32 | include 'includepar' | |
| 33 | include 'includecom' | |
| 34 | ||
| 35 | integer k | |
| 36 | real psurf,eta,fract,pp1,pp2 | |
| 37 | ||
| 38 | * | |
| 39 | * SEE BETWEEN WHICH MODEL LAYERS ETA IS SITUATED | |
| 40 | * | |
| 41 | do 10 k=2,nwz | |
| 42 | ||
| 43 | if(wheight(k).gt.eta) goto 20 | |
| 44 | ||
| 45 | 10 continue | |
| 46 | ||
| 47 | k=nwz | |
| 48 | ||
| 49 | 20 fract=(eta-wheight(k-1))/(wheight(k)-wheight(k-1)) | |
| 50 | ||
| 51 | pp1=akm(k-1)+bkm(k-1)*psurf | |
| 52 | pp2=akm(k)+bkm(k)*psurf | |
| 53 | ||
| 54 | pp=pp1*(1.-fract)+pp2*fract | |
| 55 | ||
| 56 | return | |
| 57 | end |
| 0 | subroutine pvinterpol | |
| 1 | & (pv, xt,yt,itime1,itime2,itime, pvint) | |
| 2 | C i i i i i i o | |
| 3 | ||
| 4 | C Special interpolation subroutine for pot. vorticity on a small subgrid | |
| 5 | C In horizontal direction bilinear interpolation interpolation is used. | |
| 6 | C Temporally a linear interpolation is used. | |
| 7 | C | |
| 8 | C Variables: | |
| 9 | C pv (nx,ny,nt) potential vorticity on 2*2*2 subgrid | |
| 10 | C xt,yt horizontal position in interval [0:1,0:1] | |
| 11 | C to which the interpolation is to be made | |
| 12 | C itime1,itime2 time in seconds for which PV is given | |
| 13 | C itime time in seconds for which PV is desired | |
| 14 | C pvint interpolated value of PV | |
| 15 | C | |
| 16 | C Author: Petra Seibert | |
| 17 | C based on subroutine lininterpol.f by A. Stohl from 30 May 1994 | |
| 18 | C Date: 3 May 1995 | |
| 19 | ||
| 20 | dimension pv(2,2,2), pvt(2) | |
| 21 | ||
| 22 | C bilinear horizontal interpolation | |
| 23 | ||
| 24 | ddx = xt | |
| 25 | ddy = yt | |
| 26 | ||
| 27 | rddx = 1.-ddx | |
| 28 | rddy = 1.-ddy | |
| 29 | ||
| 30 | C loop over 2 time levels | |
| 31 | ||
| 32 | do 20 n=1,2 | |
| 33 | pvt(n) = rddx * rddy * pv(1,1,n) | |
| 34 | + + ddx * rddy * pv(2,1,n) | |
| 35 | + +rddx * ddy * pv(1,2,n) | |
| 36 | + + ddx * ddy * pv(2,2,n) | |
| 37 | 20 continue | |
| 38 | ||
| 39 | C temporal interpolation (linear) | |
| 40 | ||
| 41 | dt1 = float( itime - itime1 ) | |
| 42 | dt2 = float( itime2 - itime ) | |
| 43 | pvint = (pvt(1) * dt2 + pvt(2) * dt1) / (dt1 + dt2) | |
| 44 | ||
| 45 | return | |
| 46 | end |
| 0 | C Taken from Press et al., Numerical Recipes | |
| 1 | ||
| 2 | FUNCTION RAN1(IDUM) | |
| 3 | INTEGER IDUM,IA,IM,IQ,IR,NTAB,NDIV | |
| 4 | REAL RAN1,AM,EPS,RNMX | |
| 5 | PARAMETER(IA=16807,IM=2147483647,AM=1./IM,IQ=127773,IR=2836, | |
| 6 | +NTAB=32,NDIV=1+(IM-1)/NTAB,EPS=1.2E-7,RNMX=1.-EPS) | |
| 7 | INTEGER J,K,IV(NTAB),IY | |
| 8 | SAVE IV,IY | |
| 9 | DATA IV/NTAB*0/,IY/0/ | |
| 10 | IF (IDUM.LE.0.OR.IY.EQ.0) THEN | |
| 11 | IDUM=MAX(-IDUM,1) | |
| 12 | DO J=NTAB+8,1,-1 | |
| 13 | K=IDUM/IQ | |
| 14 | IDUM=IA*(IDUM-K*IQ)-IR*K | |
| 15 | IF (IDUM.LT.0) IDUM=IDUM+IM | |
| 16 | IF (J.LE.NTAB) IV(J)=IDUM | |
| 17 | ENDDO | |
| 18 | IY=IV(1) | |
| 19 | ENDIF | |
| 20 | K=IDUM/IQ | |
| 21 | IDUM=IA*(IDUM-K*IQ)-IR*K | |
| 22 | IF (IDUM.LT.0) IDUM=IDUM+IM | |
| 23 | J=1+IY/NDIV | |
| 24 | IY=IV(J) | |
| 25 | IV(J)=IDUM | |
| 26 | RAN1=MIN(AM*IY,RNMX) | |
| 27 | RETURN | |
| 28 | END | |
| 29 | ||
| 30 | ||
| 31 | ||
| 32 | FUNCTION GASDEV(IDUM) | |
| 33 | INTEGER IDUM,ISET | |
| 34 | REAL GASDEV | |
| 35 | DATA ISET/0/ | |
| 36 | SAVE ISET,GSET | |
| 37 | IF (ISET.EQ.0) THEN | |
| 38 | 1 V1=2.*RAN1(IDUM)-1. | |
| 39 | V2=2.*RAN1(IDUM)-1. | |
| 40 | R=V1**2+V2**2 | |
| 41 | IF(R.GE.1.0 .OR. R.EQ.0.0) GO TO 1 | |
| 42 | FAC=SQRT(-2.*LOG(R)/R) | |
| 43 | GSET=V1*FAC | |
| 44 | GASDEV=V2*FAC | |
| 45 | ISET=1 | |
| 46 | ELSE | |
| 47 | GASDEV=GSET | |
| 48 | ISET=0 | |
| 49 | ENDIF | |
| 50 | RETURN | |
| 51 | END |
| 0 | subroutine readavailable(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine reads the dates and times for which windfields are available. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 6 February 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * bdate beginning date as Julian date * | |
| 14 | * beg beginning date for windfields * | |
| 15 | * end ending date for windfields * | |
| 16 | * error .true., if error ocurred in subprogram, else .false. * | |
| 17 | * fname filename of wind field, help variable * | |
| 18 | * ideltas [s] duration of modelling period * | |
| 19 | * idiff time difference between 2 wind fields * | |
| 20 | * idiffnorm normal time difference between 2 wind fields * | |
| 21 | * idiffmax [s] maximum allowable time between 2 wind fields * | |
| 22 | * jul julian date, help variable * | |
| 23 | * ldirect -1 for backward, 1 for forward trajectories * | |
| 24 | * numbnests actual number of nest levels * | |
| 25 | * numbwf actual number of wind fields * | |
| 26 | * wfname(numbwfmax) file names of needed wind fields * | |
| 27 | * wfspec(numbwfmax) file specifications of wind fields (e.g., if on disc) * | |
| 28 | * wftime(numbwfmax) [s]times of wind fields relative to beginning time * | |
| 29 | * wfname1,wfspec1,wftime1 = same as above, but only local (help variables) * | |
| 30 | * * | |
| 31 | * Constants: * | |
| 32 | * numbwfmax maximum number of wind fields * | |
| 33 | * unitavailab unit connected to file AVAILABLE * | |
| 34 | * * | |
| 35 | ******************************************************************************** | |
| 36 | ||
| 37 | include 'includepar' | |
| 38 | include 'includecom' | |
| 39 | ||
| 40 | logical error | |
| 41 | integer i,k,idiff,ldat,ltim,wftime1(numbwfmax),numbwfn(maxnests) | |
| 42 | integer wftime1n(maxnests,numbwfmax),wftimen(maxnests,numbwfmax) | |
| 43 | double precision juldate,jul,beg,end | |
| 44 | character*18 fname | |
| 45 | character*10 spec, wfspec1(numbwfmax) | |
| 46 | character*18 wfname1(numbwfmax) | |
| 47 | character*18 wfname1n(maxnests,numbwfmax) | |
| 48 | character*10 wfspec1n(maxnests,numbwfmax) | |
| 49 | ||
| 50 | ||
| 51 | ||
| 52 | error=.false. | |
| 53 | ||
| 54 | ||
| 55 | C Windfields are only used, if they are within the modelling period. | |
| 56 | C However, 1 additional day at the beginning and at the end is used for | |
| 57 | C interpolation. -> Compute beginning and ending date for the windfields. | |
| 58 | ************************************************************************* | |
| 59 | ||
| 60 | if (ideltas.gt.0) then ! forward trajectories | |
| 61 | beg=bdate-1. | |
| 62 | end=bdate+dble(float(ideltas)/86400.)+dble(float(idiffmax)/ | |
| 63 | + 86400.) | |
| 64 | else ! backward trajectories | |
| 65 | beg=bdate+dble(float(ideltas)/86400.)-dble(float(idiffmax)/ | |
| 66 | + 86400.) | |
| 67 | end=bdate+1. | |
| 68 | endif | |
| 69 | ||
| 70 | C Open the wind field availability file and read available wind fields | |
| 71 | C within the modelling period (mother grid) | |
| 72 | ********************************************************************** | |
| 73 | ||
| 74 | open(unitavailab,file=path(4)(1:len(4)),status='old', | |
| 75 | +err=999) | |
| 76 | ||
| 77 | do 10 i=1,3 | |
| 78 | 10 read(unitavailab,*) | |
| 79 | ||
| 80 | numbwf=0 | |
| 81 | 100 read(unitavailab,'(i8,1x,i6,2(6x,a18))',end=99) ldat,ltim,fname, | |
| 82 | + spec | |
| 83 | jul=juldate(ldat,ltim) | |
| 84 | if ((jul.ge.beg).and.(jul.le.end)) then | |
| 85 | numbwf=numbwf+1 | |
| 86 | if (numbwf.gt.numbwfmax) then ! check exceedance of dimension | |
| 87 | write(*,*) 'Number of wind fields needed is too great.' | |
| 88 | write(*,*) 'Reduce modelling period (file "COMMAND") or' | |
| 89 | write(*,*) 'reduce number of wind fields (file "AVAILABLE").' | |
| 90 | goto 1000 | |
| 91 | endif | |
| 92 | ||
| 93 | wfname1(numbwf)=fname(1:index(fname,' ')) | |
| 94 | wfspec1(numbwf)=spec | |
| 95 | wftime1(numbwf)=nint((jul-bdate)*86400.) | |
| 96 | endif | |
| 97 | goto 100 ! next wind field | |
| 98 | ||
| 99 | 99 continue | |
| 100 | ||
| 101 | close(unitavailab) | |
| 102 | ||
| 103 | ||
| 104 | C Open the wind field availability file and read available wind fields | |
| 105 | C within the modelling period (nested grids) | |
| 106 | ********************************************************************** | |
| 107 | ||
| 108 | do 50 k=1,numbnests | |
| 109 | open(unitavailab,file=path(numpath+2*(k-1)+2) | |
| 110 | + (1:len(numpath+2*(k-1)+2)),status='old',err=998) | |
| 111 | ||
| 112 | do 60 i=1,3 | |
| 113 | 60 read(unitavailab,*) | |
| 114 | ||
| 115 | numbwfn(k)=0 | |
| 116 | 700 read(unitavailab,'(i8,1x,i6,2(6x,a18))',end=699) ldat, | |
| 117 | + ltim,fname,spec | |
| 118 | jul=juldate(ldat,ltim) | |
| 119 | if ((jul.ge.beg).and.(jul.le.end)) then | |
| 120 | numbwfn(k)=numbwfn(k)+1 | |
| 121 | if (numbwfn(k).gt.numbwfmax) then ! check exceedance of dimension | |
| 122 | write(*,*) 'Number of nested wind fields is too great.' | |
| 123 | write(*,*) 'Reduce modelling period (file "COMMAND") or' | |
| 124 | write(*,*) 'reduce number of wind fields (file "AVAILABLE").' | |
| 125 | goto 1000 | |
| 126 | endif | |
| 127 | ||
| 128 | wfname1n(k,numbwfn(k))=fname | |
| 129 | wfspec1n(k,numbwfn(k))=spec | |
| 130 | wftime1n(k,numbwfn(k))=nint((jul-bdate)*86400.) | |
| 131 | endif | |
| 132 | goto 700 ! next wind field | |
| 133 | ||
| 134 | 699 continue | |
| 135 | ||
| 136 | 50 close(unitavailab) | |
| 137 | ||
| 138 | ||
| 139 | C Check wind field times of file AVAILABLE (expected to be in temporal order) | |
| 140 | ***************************************************************************** | |
| 141 | ||
| 142 | if (numbwf.eq.0) then | |
| 143 | write(*,*) ' #### TRAJECTORY MODEL ERROR! NO WIND FIELDS #### ' | |
| 144 | write(*,*) ' #### AVAILABLE FOR SELECTED TIME PERIOD. #### ' | |
| 145 | error=.TRUE. | |
| 146 | return | |
| 147 | endif | |
| 148 | ||
| 149 | do 150 i=2,numbwf | |
| 150 | if (wftime1(i).le.wftime1(i-1)) then | |
| 151 | write(*,*) 'FLEXTRA ERROR: FILE AVAILABLE IS CORRUPT.' | |
| 152 | write(*,*) 'THE WIND FIELDS ARE NOT IN TEMPORAL ORDER.' | |
| 153 | write(*,*) 'PLEASE CHECK FIELD ',wfname1(i) | |
| 154 | error=.TRUE. | |
| 155 | return | |
| 156 | endif | |
| 157 | 150 continue | |
| 158 | ||
| 159 | ||
| 160 | C Check wind field times of file AVAILABLE (expected to be in temporal order) | |
| 161 | ***************************************************************************** | |
| 162 | ||
| 163 | do 77 k=1,numbnests | |
| 164 | if (numbwfn(k).eq.0) then | |
| 165 | write(*,*) ' #### TRAJECTORY MODEL ERROR! NO WIND FIELDS #### ' | |
| 166 | write(*,*) ' #### AVAILABLE FOR SELECTED TIME PERIOD. #### ' | |
| 167 | error=.TRUE. | |
| 168 | return | |
| 169 | endif | |
| 170 | ||
| 171 | do 160 i=2,numbwfn(k) | |
| 172 | if (wftime1n(k,i).le.wftime1n(k,i-1)) then | |
| 173 | write(*,*) 'FLEXTRA ERROR: FILE AVAILABLE IS CORRUPT.' | |
| 174 | write(*,*) 'THE NESTED WIND FIELDS ARE NOT IN TEMPORAL ORDER.' | |
| 175 | write(*,*) 'PLEASE CHECK FIELD ',wfname1n(k,i) | |
| 176 | write(*,*) 'AT NESTING LEVEL ',k | |
| 177 | error=.TRUE. | |
| 178 | return | |
| 179 | endif | |
| 180 | 160 continue | |
| 181 | ||
| 182 | 77 continue | |
| 183 | ||
| 184 | ||
| 185 | C For backward trajectories, reverse the order of the windfields | |
| 186 | **************************************************************** | |
| 187 | ||
| 188 | if (ideltas.ge.0) then | |
| 189 | do 200 i=1,numbwf | |
| 190 | wfname(i)=wfname1(i) | |
| 191 | wfspec(i)=wfspec1(i) | |
| 192 | 200 wftime(i)=wftime1(i) | |
| 193 | do 210 k=1,numbnests | |
| 194 | do 210 i=1,numbwfn(k) | |
| 195 | wfnamen(k,i)=wfname1n(k,i) | |
| 196 | wfspecn(k,i)=wfspec1n(k,i) | |
| 197 | 210 wftimen(k,i)=wftime1n(k,i) | |
| 198 | else | |
| 199 | do 300 i=1,numbwf | |
| 200 | wfname(numbwf-i+1)=wfname1(i) | |
| 201 | wfspec(numbwf-i+1)=wfspec1(i) | |
| 202 | 300 wftime(numbwf-i+1)=wftime1(i) | |
| 203 | do 310 k=1,numbnests | |
| 204 | do 310 i=1,numbwfn(k) | |
| 205 | wfnamen(k,numbwfn(k)-i+1)=wfname1n(k,i) | |
| 206 | wfspecn(k,numbwfn(k)-i+1)=wfspec1n(k,i) | |
| 207 | 310 wftimen(k,numbwfn(k)-i+1)=wftime1n(k,i) | |
| 208 | endif | |
| 209 | ||
| 210 | ||
| 211 | C Check the time difference between the wind fields. If it is big, | |
| 212 | C write a warning message. If it is too big, terminate the trajectory. | |
| 213 | ********************************************************************** | |
| 214 | ||
| 215 | do 350 i=2,numbwf | |
| 216 | idiff=abs(wftime(i)-wftime(i-1)) | |
| 217 | if (idiff.gt.idiffmax) then | |
| 218 | write(*,*) 'FLEXTRA WARNING: TIME DIFFERENCE BETWEEN TWO' | |
| 219 | write(*,*) 'WIND FIELDS IS TOO BIG FOR TRAJECTORY CALCULATION. | |
| 220 | & ' | |
| 221 | write(*,*) 'THEREFORE, TRAJECTORIES HAVE TO BE SKIPPED.' | |
| 222 | else if (idiff.gt.idiffnorm) then | |
| 223 | write(*,*) 'FLEXTRA WARNING: TIME DIFFERENCE BETWEEN TWO' | |
| 224 | write(*,*) 'WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION' | |
| 225 | write(*,*) 'OF TRAJECTORY QUALITY.' | |
| 226 | endif | |
| 227 | 350 continue | |
| 228 | ||
| 229 | do 360 k=1,numbnests | |
| 230 | if (numbwfn(k).ne.numbwf) then | |
| 231 | write(*,*) 'FLEXTRA ERROR: THE AVAILABLE FILES FOR THE' | |
| 232 | write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH' | |
| 233 | write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN. ' | |
| 234 | write(*,*) 'ERROR AT NEST LEVEL: ',k | |
| 235 | goto 1000 | |
| 236 | endif | |
| 237 | do 360 i=1,numbwf | |
| 238 | if (wftimen(k,i).ne.wftime(i)) then | |
| 239 | write(*,*) 'FLEXTRA ERROR: THE AVAILABLE FILES FOR THE' | |
| 240 | write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH' | |
| 241 | write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN. ' | |
| 242 | write(*,*) 'ERROR AT NEST LEVEL: ',k | |
| 243 | goto 1000 | |
| 244 | endif | |
| 245 | 360 continue | |
| 246 | ||
| 247 | ||
| 248 | C Reset the times of the wind fields that are kept in memory to no time | |
| 249 | *********************************************************************** | |
| 250 | ||
| 251 | do 30 i=1,3 | |
| 252 | memind(i)=i | |
| 253 | 30 memtime(i)=999999999 | |
| 254 | ||
| 255 | return | |
| 256 | ||
| 257 | 998 write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE #### ' | |
| 258 | write(*,'(a)') ' '//path(numpath+2*(k-1)+2) | |
| 259 | +(1:len(numpath+2*(k-1)+2)) | |
| 260 | write(*,*) ' #### CANNOT BE OPENED #### ' | |
| 261 | error=.true. | |
| 262 | return | |
| 263 | ||
| 264 | 999 write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE #### ' | |
| 265 | write(*,'(a)') ' '//path(4)(1:len(4)) | |
| 266 | write(*,*) ' #### CANNOT BE OPENED #### ' | |
| 267 | 1000 error=.true. | |
| 268 | ||
| 269 | return | |
| 270 | end |
| 0 | subroutine readcet(error) | |
| 1 | C o | |
| 2 | *********************************************************************** | |
| 3 | * * | |
| 4 | * TRAJECTORY MODEL SUBROUTINE READCET * | |
| 5 | * * | |
| 6 | *********************************************************************** | |
| 7 | * * | |
| 8 | * AUTHOR: A. STOHL * | |
| 9 | * DATE: 1999-01-11 * | |
| 10 | * * | |
| 11 | * Update: Vertical coordinate can now be given in meters above sea * | |
| 12 | * level, meters above ground, and in hPa. * | |
| 13 | * * | |
| 14 | *********************************************************************** | |
| 15 | * * | |
| 16 | * DESCRIPTION: * | |
| 17 | * * | |
| 18 | * READING OF TRAJECTORY STARTING/ENDING POINTS FROM DATA FILE * | |
| 19 | * * | |
| 20 | * LINE a line of text * | |
| 21 | * NUMPOINT number of trajectory starting/ending points * | |
| 22 | * XPOINT(maxpoint) x-coordinates of starting/ending points * | |
| 23 | * YPOINT(maxpoint) y-coordinates of starting/ending points * | |
| 24 | * ZPOINT(maxpoint) z-coordinates of starting/ending points * | |
| 25 | * KINDZ(maxpoint) kind of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 26 | * KIND(maxpoint) kind of trajectory * | |
| 27 | * COMPOINT(maxpoint) comment for trajectory output * | |
| 28 | * * | |
| 29 | *********************************************************************** | |
| 30 | * | |
| 31 | include 'includepar' | |
| 32 | include 'includecom' | |
| 33 | ||
| 34 | integer isum | |
| 35 | logical error,old | |
| 36 | integer kindhelp,kindzhelp | |
| 37 | real xhelpleft,xhelpright,yhelpleft,yhelpright,deltax | |
| 38 | real deltay,zhelplower,zhelpupper,deltaz,xi,yj,zk | |
| 39 | character*45 comhelp,line | |
| 40 | ||
| 41 | error=.false. | |
| 42 | * | |
| 43 | * OPENING OF FILE 'STARTCET' | |
| 44 | * | |
| 45 | ||
| 46 | open(unitpoin,file=path(1)(1:len(1))//'STARTCET', | |
| 47 | +status='old',err=999) | |
| 48 | ||
| 49 | C Check the format of the STARTCET file (either in free format, | |
| 50 | C or using formatted mask) | |
| 51 | C Use of formatted mask is assumed if line 28 contains the word '____' | |
| 52 | ********************************************************************** | |
| 53 | ||
| 54 | call skplin(27,unitpoin) | |
| 55 | read (unitpoin,901) line | |
| 56 | 901 format (a) | |
| 57 | if (index(line,'____') .eq. 0) then | |
| 58 | old = .false. | |
| 59 | else | |
| 60 | old = .true. | |
| 61 | endif | |
| 62 | rewind(unitpoin) | |
| 63 | ||
| 64 | * | |
| 65 | * READING OF STARTING/ENDING POINTS OF TRAJECTORIES | |
| 66 | * | |
| 67 | call skplin(26,unitpoin) | |
| 68 | ||
| 69 | read(unitpoin,*,err=998,end=998) xhelpleft | |
| 70 | if (old) call skplin(2,unitpoin) | |
| 71 | read(unitpoin,*,err=998,end=998) yhelpleft | |
| 72 | if (old) call skplin(2,unitpoin) | |
| 73 | read(unitpoin,*,err=998,end=998) xhelpright | |
| 74 | if (old) call skplin(2,unitpoin) | |
| 75 | read(unitpoin,*,err=998,end=998) yhelpright | |
| 76 | if (old) call skplin(2,unitpoin) | |
| 77 | read(unitpoin,*,err=998,end=998) deltax | |
| 78 | if (old) call skplin(2,unitpoin) | |
| 79 | read(unitpoin,*,err=998,end=998) deltay | |
| 80 | if (old) call skplin(2,unitpoin) | |
| 81 | read(unitpoin,*,err=998,end=998) kindhelp | |
| 82 | if (old) call skplin(2,unitpoin) | |
| 83 | read(unitpoin,*,err=998,end=998) kindzhelp | |
| 84 | if (old) call skplin(2,unitpoin) | |
| 85 | read(unitpoin,*,err=998,end=998) zhelplower | |
| 86 | if (old) call skplin(2,unitpoin) | |
| 87 | read(unitpoin,*,err=998,end=998) zhelpupper | |
| 88 | if (old) call skplin(2,unitpoin) | |
| 89 | read(unitpoin,*,err=998,end=998) deltaz | |
| 90 | if (old) call skplin(2,unitpoin) | |
| 91 | if (old) then | |
| 92 | read(unitpoin,'(a40)',err=998,end=998) comhelp(1:40) | |
| 93 | else | |
| 94 | read(unitpoin,*,err=998,end=998) comhelp(1:40) | |
| 95 | endif | |
| 96 | if (old) call skplin(1,unitpoin) | |
| 97 | close(unitpoin) | |
| 98 | 1 format(1x,a17,i6,a28) | |
| 99 | ||
| 100 | ||
| 101 | if (zhelpupper.lt.zhelplower) stop 'Upper level must be greater | |
| 102 | +than lower level' | |
| 103 | ||
| 104 | ||
| 105 | C Forbid mixing layer trajectories | |
| 106 | ********************************** | |
| 107 | ||
| 108 | if (kindhelp.eq.3) then | |
| 109 | write(*,*) '### Mixing layer trajectories not allowed ###' | |
| 110 | write(*,*) '### for CET calculations. Select a ###' | |
| 111 | write(*,*) '### different trajectory type! ###' | |
| 112 | error=.true. | |
| 113 | return | |
| 114 | endif | |
| 115 | ||
| 116 | ||
| 117 | C Check field dimension | |
| 118 | *********************** | |
| 119 | ||
| 120 | isum=int(((xhelpright-xhelpleft)/deltax+1.)*((yhelpright- | |
| 121 | +yhelpleft)/deltay+1.)*(abs(zhelpupper-zhelplower)/deltaz +1.)) | |
| 122 | ||
| 123 | ||
| 124 | if (isum.gt.maxtra) then | |
| 125 | write(*,*) ' #### TRAJECTORY MODEL ERROR! MODEL CAN NOT #### ' | |
| 126 | write(*,*) ' #### KEEP SO MANY TRAJECTORIES IN MEMORY. #### ' | |
| 127 | write(*,1) ' #### CURRENTLY: ',isum,' #### | |
| 128 | + ' | |
| 129 | write(*,1) ' #### MAXIMUM: ',maxtra,' #### | |
| 130 | + ' | |
| 131 | write(*,*) ' #### REDUCE CET DOMAIN OR RESOLUTION. #### ' | |
| 132 | error=.true. | |
| 133 | endif | |
| 134 | ||
| 135 | ||
| 136 | C Initialize CET starting points | |
| 137 | ******************************** | |
| 138 | ||
| 139 | isum=0 | |
| 140 | do 10 xi=xhelpleft,xhelpright,deltax | |
| 141 | do 10 yj=yhelpleft,yhelpright,deltay | |
| 142 | do 10 zk=zhelplower,zhelpupper,deltaz | |
| 143 | isum=isum+1 | |
| 144 | xpoint(isum)=xi | |
| 145 | ypoint(isum)=yj | |
| 146 | kind(isum)=kindhelp | |
| 147 | kindz(isum)=kindzhelp | |
| 148 | zpoint(isum)=zk | |
| 149 | compoint(isum)(1:40)=comhelp(1:40) | |
| 150 | ||
| 151 | C Conversion from hPa to Pa, if z coordinate is given in pressure units | |
| 152 | if (kindz(isum).eq.3) zpoint(isum)=zpoint(isum)*100. | |
| 153 | 10 continue | |
| 154 | ||
| 155 | numpoint=isum | |
| 156 | ||
| 157 | return | |
| 158 | ||
| 159 | 998 error=.true. | |
| 160 | write(*,*) '#### TRAJECTORY MODEL SUBROUTINE READCET: '// | |
| 161 | & '#### ' | |
| 162 | write(*,*) '#### FATAL ERROR - FILE "STARTCET" IS '// | |
| 163 | & '#### ' | |
| 164 | write(*,*) '#### CORRUPT. PLEASE CHECK YOUR INPUTS FOR '// | |
| 165 | & '#### ' | |
| 166 | write(*,*) '#### MISTAKES OR GET A NEW "STARTPOINTS"- '// | |
| 167 | & '#### ' | |
| 168 | write(*,*) '#### FILE ... '// | |
| 169 | & '#### ' | |
| 170 | return | |
| 171 | ||
| 172 | 999 error=.true. | |
| 173 | write(*,*) | |
| 174 | write(*,*) ' ###########################################'// | |
| 175 | & '###### ' | |
| 176 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE READCET:' | |
| 177 | write(*,*) | |
| 178 | write(*,*) ' FATAL ERROR - FILE STARTCET IS NOT AVAILABLE' | |
| 179 | write(*,*) ' OR YOU ARE NOT PERMITTED FOR ANY ACCESS' | |
| 180 | write(*,*) ' ###########################################'// | |
| 181 | & '###### ' | |
| 182 | ||
| 183 | return | |
| 184 | end |
| 0 | subroutine readcommand(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine reads the user specifications for the current model run. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 2 February 1994 * | |
| 9 | * * | |
| 10 | * 10 January 1999 Update to facilitate free formatted input * | |
| 11 | * (P. Seibert + A. Stohl) * | |
| 12 | ******************************************************************************** | |
| 13 | * * | |
| 14 | * Variables: * | |
| 15 | * bdate beginning date as Julian date * | |
| 16 | * edate ending date as Julian date * | |
| 17 | * error .true., if error ocurred in subprogram, else .false. * | |
| 18 | * hhh hour * | |
| 19 | * ibdate,ibtime beginnning date and time (YYYYMMDD, HHMISS) * | |
| 20 | * ideltas [s] modelling period * | |
| 21 | * iedate,ietime ending date and time (YYYYMMDD, HHMISS) * | |
| 22 | * interv [s] interval between two trajectory calculations * | |
| 23 | * ldirect -1 for backward, 1 for forward trajectories * | |
| 24 | * lentra [s] length of one trajectory * | |
| 25 | * line a line of text * | |
| 26 | * ldim number of steps along the interpolated trajectory * | |
| 27 | * mi minute * | |
| 28 | * relaxtime time constant at which random errors are relaxed * | |
| 29 | * ss second * | |
| 30 | * * | |
| 31 | * Constants: * | |
| 32 | * unitcommand unit connected to file COMMAND * | |
| 33 | * * | |
| 34 | ******************************************************************************** | |
| 35 | ||
| 36 | include 'includepar' | |
| 37 | include 'includecom' | |
| 38 | ||
| 39 | logical error,old | |
| 40 | integer hhh,mi,ss | |
| 41 | double precision edate,juldate | |
| 42 | character*50 line | |
| 43 | ||
| 44 | ||
| 45 | C Open the command file and read user options | |
| 46 | ********************************************* | |
| 47 | ||
| 48 | error=.false. | |
| 49 | ||
| 50 | open(unitcommand,file=path(1)(1:len(1))//'COMMAND',status='old', | |
| 51 | +err=999) | |
| 52 | ||
| 53 | C Check the format of the COMMAND file (either in free format, | |
| 54 | C or using formatted mask) | |
| 55 | C Use of formatted mask is assumed if line 9 contains the word 'LABEL' | |
| 56 | ********************************************************************** | |
| 57 | ||
| 58 | call skplin(8,unitcommand) | |
| 59 | read (unitcommand,901) line | |
| 60 | 901 format (a) | |
| 61 | if (index(line,'LABEL') .eq. 0) then | |
| 62 | old = .false. | |
| 63 | else | |
| 64 | old = .true. | |
| 65 | endif | |
| 66 | rewind(unitcommand) | |
| 67 | ||
| 68 | C Read parameters | |
| 69 | ***************** | |
| 70 | ||
| 71 | call skplin(6,unitcommand) | |
| 72 | if (old) call skplin(1,unitcommand) | |
| 73 | if (old) then | |
| 74 | read(unitcommand,'(3x,a50)') runcomment | |
| 75 | else | |
| 76 | read(unitcommand,*) runcomment | |
| 77 | endif | |
| 78 | if (old) call skplin(3,unitcommand) | |
| 79 | read(unitcommand,*) ldirect | |
| 80 | if (old) call skplin(3,unitcommand) | |
| 81 | read(unitcommand,*) lentra | |
| 82 | if (old) call skplin(3,unitcommand) | |
| 83 | read(unitcommand,*) ibdate,ibtime | |
| 84 | if (old) call skplin(3,unitcommand) | |
| 85 | read(unitcommand,*) iedate,ietime | |
| 86 | if (old) call skplin(3,unitcommand) | |
| 87 | read(unitcommand,*) interv | |
| 88 | interv=max(interv,1) ! minimum interval 1 second | |
| 89 | if (old) call skplin(3,unitcommand) | |
| 90 | read(unitcommand,*) inter,interstep | |
| 91 | if (old) call skplin(3,unitcommand) | |
| 92 | read(unitcommand,*) numbunc,distunc,relaxtime,epsu,epsv,epsw | |
| 93 | if (old) call skplin(3,unitcommand) | |
| 94 | read(unitcommand,*) inpolkind | |
| 95 | if (old) call skplin(3,unitcommand) | |
| 96 | read(unitcommand,*) cfl | |
| 97 | if (old) call skplin(3,unitcommand) | |
| 98 | read(unitcommand,*) cflt | |
| 99 | if (old) call skplin(3,unitcommand) | |
| 100 | read(unitcommand,*) modecet | |
| 101 | ||
| 102 | close(unitcommand) | |
| 103 | ||
| 104 | ||
| 105 | C Check input dates | |
| 106 | ******************* | |
| 107 | ||
| 108 | if (iedate.lt.ibdate) then | |
| 109 | write(*,*) ' #### TRAJECTORY MODEL ERROR! BEGINNING DATE #### ' | |
| 110 | write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE #### ' | |
| 111 | write(*,*) ' #### EITHER POINT 3 OR POINT 4 IN FILE #### ' | |
| 112 | write(*,*) ' #### "COMMAND". #### ' | |
| 113 | error=.true. | |
| 114 | return | |
| 115 | else if (iedate.eq.ibdate) then | |
| 116 | if (ietime.lt.ibtime) then | |
| 117 | write(*,*) ' #### TRAJECTORY MODEL ERROR! BEGINNING TIME #### ' | |
| 118 | write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE #### ' | |
| 119 | write(*,*) ' #### EITHER POINT 3 OR POINT 4 IN FILE #### ' | |
| 120 | write(*,*) ' #### "COMMAND". #### ' | |
| 121 | error=.true. | |
| 122 | return | |
| 123 | ||
| 124 | endif | |
| 125 | endif | |
| 126 | ||
| 127 | ||
| 128 | C Check CFL criterions | |
| 129 | ********************** | |
| 130 | ||
| 131 | if((cfl.lt.1.).or.(cflt.lt.1.)) then | |
| 132 | write(*,*) ' #### TRAJECTORY MODEL ERROR! CFL CRITERION #### ' | |
| 133 | write(*,*) ' #### MUST NOT BE SET LESS THEN 1 !!! #### ' | |
| 134 | error=.true. | |
| 135 | return | |
| 136 | endif | |
| 137 | ||
| 138 | ||
| 139 | C Conversion of format HHHMISS to seconds | |
| 140 | ***************************************** | |
| 141 | ||
| 142 | hhh=lentra/10000 | |
| 143 | mi=(lentra-10000*hhh)/100 | |
| 144 | ss=lentra-10000*hhh-100*mi | |
| 145 | lentra=ldirect*(hhh*3600+60*mi+ss) | |
| 146 | ||
| 147 | hhh=interv/10000 | |
| 148 | mi=(interv-10000*hhh)/100 | |
| 149 | ss=interv-10000*hhh-100*mi | |
| 150 | interv=hhh*3600+60*mi+ss | |
| 151 | ||
| 152 | ||
| 153 | C Compute number of time steps along interpolated trajectory | |
| 154 | ************************************************************ | |
| 155 | ||
| 156 | if (interstep.lt.1) interstep=1 | |
| 157 | ldim=ldirect*lentra/interstep+1 | |
| 158 | ||
| 159 | if ((inter.ge.0).and.(ldim.gt.maxitime)) then | |
| 160 | write(*,*) ' #### TRAJECTORY MODEL ERROR! INTERPOLATION #### ' | |
| 161 | write(*,*) ' #### TO SUCH A SHORT TIME STEP IS NOT #### ' | |
| 162 | write(*,*) ' #### POSSIBLE. SET SSSSS IN POINT 7. OF FILE #### ' | |
| 163 | write(*,*) ' #### "COMMAND" TO A GREATER VALUE. #### ' | |
| 164 | error=.true. | |
| 165 | return | |
| 166 | endif | |
| 167 | ||
| 168 | if ((inter.eq.1).and.(maxtime.lt.2*ldim+1)) then | |
| 169 | write(*,*) ' #### TRAJECTORY MODEL ERROR! INTERPOLATION #### ' | |
| 170 | write(*,*) ' #### TO SUCH A SHORT TIME STEP IS NOT #### ' | |
| 171 | write(*,*) ' #### SENSIBLE GIVEN CURRENT SETTING OF #### ' | |
| 172 | write(*,*) ' #### MAXTRA. SET SSSSS IN POINT 7. OF FILE #### ' | |
| 173 | write(*,*) ' #### "COMMAND" TO A GREATER VALUE. #### ' | |
| 174 | error=.true. | |
| 175 | return | |
| 176 | endif | |
| 177 | ||
| 178 | C Compute modelling time in seconds and beginning date in Julian date | |
| 179 | ********************************************************************* | |
| 180 | ||
| 181 | if (ldirect.eq.1) then | |
| 182 | bdate=juldate(ibdate,ibtime) | |
| 183 | edate=juldate(iedate,ietime) | |
| 184 | ideltas=nint(86400.*(edate-bdate))+lentra | |
| 185 | else if (ldirect.eq.-1) then | |
| 186 | bdate=juldate(iedate,ietime) | |
| 187 | edate=juldate(ibdate,ibtime) | |
| 188 | ideltas=nint(86400.*(edate-bdate))+lentra | |
| 189 | else | |
| 190 | write(*,*) ' #### TRAJECTORY MODEL ERROR! DIRECTION IN #### ' | |
| 191 | write(*,*) ' #### FILE "COMMAND" MUST BE EITHER -1 OR 1. #### ' | |
| 192 | error=.true. | |
| 193 | return | |
| 194 | endif | |
| 195 | ||
| 196 | ||
| 197 | return | |
| 198 | ||
| 199 | 999 write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE "COMMAND" #### ' | |
| 200 | write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY #### ' | |
| 201 | write(*,*) ' #### xxx/trajec/options #### ' | |
| 202 | error=.true. | |
| 203 | ||
| 204 | return | |
| 205 | end |
| 0 | subroutine readflight(error) | |
| 1 | C o | |
| 2 | *********************************************************************** | |
| 3 | * * | |
| 4 | * TRAJECTORY MODEL SUBROUTINE READCET * | |
| 5 | * * | |
| 6 | *********************************************************************** | |
| 7 | * * | |
| 8 | * AUTHOR: A. STOHL * | |
| 9 | * DATE: 1999-02-01 * | |
| 10 | * * | |
| 11 | * Update: Vertical coordinate can now be given in meters above sea * | |
| 12 | * level, meters above ground, and in hPa. * | |
| 13 | * * | |
| 14 | *********************************************************************** | |
| 15 | * * | |
| 16 | * DESCRIPTION: * | |
| 17 | * * | |
| 18 | * READING OF TRAJECTORY STARTING/ENDING POINTS FROM DATA FILE * | |
| 19 | * * | |
| 20 | * LINE a line of text * | |
| 21 | * NUMPOINT number of trajectory starting/ending points * | |
| 22 | * XPOINT(maxpoint) x-coordinates of starting/ending points * | |
| 23 | * YPOINT(maxpoint) y-coordinates of starting/ending points * | |
| 24 | * ZPOINT(maxpoint) z-coordinates of starting/ending points * | |
| 25 | * KINDZ(maxpoint) kind of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 26 | * KIND(maxpoint) kind of trajectory * | |
| 27 | * COMPOINT(maxpoint) comment for trajectory output * | |
| 28 | * * | |
| 29 | *********************************************************************** | |
| 30 | * | |
| 31 | include 'includepar' | |
| 32 | include 'includecom' | |
| 33 | ||
| 34 | logical error | |
| 35 | integer ldat,ltim | |
| 36 | double precision juldate | |
| 37 | ||
| 38 | error=.false. | |
| 39 | ||
| 40 | * Open file 'STARTFLIGHT' | |
| 41 | ************************* | |
| 42 | ||
| 43 | open(unitpoin,file=path(1)(1:len(1))//'STARTFLIGHT', | |
| 44 | +status='old',err=999) | |
| 45 | ||
| 46 | call skplin(27,unitpoin) | |
| 47 | read(unitpoin,'(a)',err=998,end=998) compoint(1)(1:40) | |
| 48 | read(unitpoin,*,err=998,end=998) kind(1) | |
| 49 | read(unitpoin,*,err=998,end=998) kindz(1) | |
| 50 | call skplin(1,unitpoin) | |
| 51 | ||
| 52 | C Read the first starting point | |
| 53 | ******************************* | |
| 54 | ||
| 55 | read(unitpoin,*,err=998,end=998) ldat,ltim | |
| 56 | read(unitpoin,*,err=998,end=998) xpoint(1) | |
| 57 | read(unitpoin,*,err=998,end=998) ypoint(1) | |
| 58 | read(unitpoin,*,err=998,end=998) zpoint(1) | |
| 59 | call skplin(1,unitpoin) | |
| 60 | nextflight=nint(sngl(juldate(ldat,ltim)-bdate)*86400.) | |
| 61 | if (kindz(1).eq.3) zpoint(1)=zpoint(1)*100. | |
| 62 | ||
| 63 | numpoint=1 | |
| 64 | ||
| 65 | ||
| 66 | C Forbid mixing layer trajectories | |
| 67 | ********************************** | |
| 68 | ||
| 69 | if (kind(1).eq.3) then | |
| 70 | write(*,*) '### Mixing layer trajectories not allowed ###' | |
| 71 | write(*,*) '### for FLIGHT calculations. Select a ###' | |
| 72 | write(*,*) '### different trajectory type! ###' | |
| 73 | error=.true. | |
| 74 | return | |
| 75 | endif | |
| 76 | ||
| 77 | return | |
| 78 | ||
| 79 | 998 error=.true. | |
| 80 | write(*,*) '#### TRAJECTORY MODEL SUBROUTINE READFLIGHT: '// | |
| 81 | & '#### ' | |
| 82 | write(*,*) '#### FATAL ERROR - FILE "STARTFLIGHT" IS '// | |
| 83 | & '#### ' | |
| 84 | write(*,*) '#### CORRUPT. PLEASE CHECK YOUR INPUTS FOR '// | |
| 85 | & '#### ' | |
| 86 | write(*,*) '#### MISTAKES OR GET A NEW "STARTPOINTS"- '// | |
| 87 | & '#### ' | |
| 88 | write(*,*) '#### FILE ... '// | |
| 89 | & '#### ' | |
| 90 | return | |
| 91 | ||
| 92 | 999 error=.true. | |
| 93 | write(*,*) | |
| 94 | write(*,*) ' ###########################################'// | |
| 95 | & '###### ' | |
| 96 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE READFLIGHT:' | |
| 97 | write(*,*) | |
| 98 | write(*,*) ' FATAL ERROR - FILE STARTFLIGHT IS NOT AVAILABLE' | |
| 99 | write(*,*) ' OR YOU ARE NOT PERMITTED FOR ANY ACCESS' | |
| 100 | write(*,*) ' ###########################################'// | |
| 101 | & '###### ' | |
| 102 | ||
| 103 | return | |
| 104 | end |
| 0 | subroutine readoro(error) | |
| 1 | C o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine reads the orography used by the ECMWF model. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 30 April 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * error .true., if file OROGRAPHY cannot be opened * | |
| 14 | * nx,ny number of grid points in x and y direction, respectively* | |
| 15 | * oro(0:nxmax-1,0:nymax-1) [m] orography of ECMWF model * | |
| 16 | * * | |
| 17 | * Constants: * | |
| 18 | * unitoro unit connected to file OROGRAPHY * | |
| 19 | * * | |
| 20 | ******************************************************************************** | |
| 21 | ||
| 22 | include 'includepar' | |
| 23 | include 'includecom' | |
| 24 | ||
| 25 | integer ix,jy | |
| 26 | logical error | |
| 27 | ||
| 28 | ||
| 29 | error=.false. | |
| 30 | ||
| 31 | C Open the orography file and read grid | |
| 32 | *************************************** | |
| 33 | ||
| 34 | write(*,*) 'NOTICE: OROGRAPHY WAS READ FROM FILE "OROGRAPHY"' | |
| 35 | ||
| 36 | ||
| 37 | open(unitoro,file=path(3)(1:len(3))//'OROGRAPHY', | |
| 38 | +status='old',err=999) | |
| 39 | do 10 ix=0,nx-1 | |
| 40 | do 10 jy=0,ny-1 | |
| 41 | 10 read(unitoro,*) oro(ix,jy) | |
| 42 | close(unitoro) | |
| 43 | ||
| 44 | return | |
| 45 | ||
| 46 | 999 write(*,*) ' #### FLEXTRA MODEL ERROR! FILE "OROGRAPHY" #### ' | |
| 47 | write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY #### ' | |
| 48 | write(*,*) ' #### xxx/trajec/windfields #### ' | |
| 49 | error=.true. | |
| 50 | ||
| 51 | return | |
| 52 | end |
| 0 | subroutine readpaths(error) | |
| 1 | c o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * Reads the pathnames, where input/output files are expected to be. * | |
| 5 | * The file pathnames must be available in the current working directory. * | |
| 6 | * * | |
| 7 | * Author: A. Stohl * | |
| 8 | * * | |
| 9 | * 1 February 1994 * | |
| 10 | * * | |
| 11 | ******************************************************************************** | |
| 12 | * * | |
| 13 | * Variables: * | |
| 14 | * error .true., if file pathnames does not exist * | |
| 15 | * len(numpath) lengths of the path names * | |
| 16 | * path(numpath) pathnames of input/output files * | |
| 17 | * * | |
| 18 | * Constants: * | |
| 19 | * numpath number of pathnames to be read in * | |
| 20 | * * | |
| 21 | ******************************************************************************** | |
| 22 | ||
| 23 | include 'includepar' | |
| 24 | include 'includecom' | |
| 25 | ||
| 26 | integer i | |
| 27 | logical error | |
| 28 | ||
| 29 | error=.false. | |
| 30 | ||
| 31 | C Read the pathname information stored in unitpath | |
| 32 | ************************************************** | |
| 33 | ||
| 34 | open(unitpath,file='pathnames',status='old',err=999) | |
| 35 | ||
| 36 | do 10 i=1,numpath | |
| 37 | read(unitpath,'(a)',err=998) path(i) | |
| 38 | 10 len(i)=index(path(i),' ')-1 | |
| 39 | ||
| 40 | C Check whether any nested subdomains are to be used | |
| 41 | **************************************************** | |
| 42 | ||
| 43 | do 20 i=1,maxnests | |
| 44 | read(unitpath,'(a)') path(numpath+2*(i-1)+1) | |
| 45 | read(unitpath,'(a)') path(numpath+2*(i-1)+2) | |
| 46 | if (path(numpath+2*(i-1)+1)(1:5).eq.'=====') goto 30 | |
| 47 | len(numpath+2*(i-1)+1)=index(path(numpath+2*(i-1)+1),' ')-1 | |
| 48 | 20 len(numpath+2*(i-1)+2)=index(path(numpath+2*(i-1)+2),' ')-1 | |
| 49 | ||
| 50 | ||
| 51 | C Determine number of available nested domains | |
| 52 | ********************************************** | |
| 53 | ||
| 54 | 30 numbnests=i-1 | |
| 55 | ||
| 56 | ||
| 57 | close(unitpath) | |
| 58 | return | |
| 59 | ||
| 60 | 998 write(*,*) ' #### TRAJECTORY MODEL ERROR! ERROR WHILE #### ' | |
| 61 | write(*,*) ' #### READING FILE PATHNAMES. #### ' | |
| 62 | ||
| 63 | 999 write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE "pathnames"#### ' | |
| 64 | write(*,*) ' #### CANNOT BE OPENED IN THE CURRENT WORKING #### ' | |
| 65 | write(*,*) ' #### DIRECTORY. #### ' | |
| 66 | error=.true. | |
| 67 | ||
| 68 | return | |
| 69 | end |
| 0 | subroutine readpoints(error) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE READPOINTS * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1994-02-03 * | |
| 9 | * LAST UPDATE: 1996-06-21 A. Stohl * | |
| 10 | * * | |
| 11 | * Update: Vertical coordinate can now be given in meters above sea * | |
| 12 | * level, meters above ground, and in hPa. * | |
| 13 | * * | |
| 14 | * 10 January 1999 Update to facilitate free formatted input * | |
| 15 | * (P. Seibert + A. Stohl) * | |
| 16 | * * | |
| 17 | *********************************************************************** | |
| 18 | * * | |
| 19 | * DESCRIPTION: * | |
| 20 | * * | |
| 21 | * READING OF TRAJECTORY STARTING/ENDING POINTS FROM DATA FILE * | |
| 22 | * * | |
| 23 | * LINE a line of text * | |
| 24 | * NUMPOINT number of trajectory starting/ending points * | |
| 25 | * XPOINT(maxpoint) x-coordinates of starting/ending points * | |
| 26 | * YPOINT(maxpoint) y-coordinates of starting/ending points * | |
| 27 | * ZPOINT(maxpoint) z-coordinates of starting/ending points * | |
| 28 | * KINDZ(maxpoint) kind of z coordinate (1:masl, 2:magl, 3:hPa) * | |
| 29 | * KIND(maxpoint) kind of trajectory * | |
| 30 | * COMPOINT(maxpoint) comment for trajectory output * | |
| 31 | * * | |
| 32 | *********************************************************************** | |
| 33 | * | |
| 34 | include 'includepar' | |
| 35 | include 'includecom' | |
| 36 | ||
| 37 | integer isum | |
| 38 | logical error,old | |
| 39 | integer kindhelp,kindzhelp | |
| 40 | real xhelp,yhelp,zhelp | |
| 41 | character*45 comhelp,line | |
| 42 | ||
| 43 | error=.false. | |
| 44 | * | |
| 45 | * OPENING OF FILE 'STARTPOINTS' | |
| 46 | * | |
| 47 | ||
| 48 | open(unitpoin,file=path(1)(1:len(1))//'STARTPOINTS', | |
| 49 | & status='old',err=999) | |
| 50 | ||
| 51 | C Check the format of the STARTPOINTS file (either in free format, | |
| 52 | C or using formatted mask) | |
| 53 | C Use of formatted mask is assumed if line 28 contains the word '____' | |
| 54 | ********************************************************************** | |
| 55 | ||
| 56 | call skplin(27,unitpoin) | |
| 57 | read (unitpoin,901) line | |
| 58 | 901 format (a) | |
| 59 | if (index(line,'____') .eq. 0) then | |
| 60 | old = .false. | |
| 61 | else | |
| 62 | old = .true. | |
| 63 | endif | |
| 64 | rewind(unitpoin) | |
| 65 | ||
| 66 | * | |
| 67 | * READING OF STARTING/ENDING POINTS OF TRAJECTORIES | |
| 68 | * | |
| 69 | call skplin(26,unitpoin) | |
| 70 | ||
| 71 | 10 continue | |
| 72 | isum=0 | |
| 73 | 100 read(unitpoin,*,err=998,end=25) xhelp | |
| 74 | if (old) call skplin(2,unitpoin) | |
| 75 | read(unitpoin,*,err=998,end=25) yhelp | |
| 76 | if (old) call skplin(2,unitpoin) | |
| 77 | read(unitpoin,*,err=998,end=25) kindhelp | |
| 78 | if (old) call skplin(2,unitpoin) | |
| 79 | read(unitpoin,*,err=998,end=25) kindzhelp | |
| 80 | if (old) call skplin(2,unitpoin) | |
| 81 | read(unitpoin,*,err=998,end=25) zhelp | |
| 82 | if (old) call skplin(2,unitpoin) | |
| 83 | if (old) then | |
| 84 | read(unitpoin,'(a40)',err=998,end=25) comhelp(1:40) | |
| 85 | else | |
| 86 | read(unitpoin,*,err=998,end=25) comhelp(1:40) | |
| 87 | endif | |
| 88 | if (old) call skplin(1,unitpoin) | |
| 89 | call skplin(1,unitpoin) | |
| 90 | ||
| 91 | if((xhelp.eq.0.).and.(yhelp.eq.0.).and. | |
| 92 | & (zhelp.eq.0.).and.(comhelp(1:8).eq.' ')) | |
| 93 | & goto 25 | |
| 94 | ||
| 95 | ||
| 96 | if ((kindhelp.eq.3).and.(kindzhelp.ne.2)) then | |
| 97 | write(*,*) ' #### FLEXTRA MODEL ERROR! FOR MIXING LAYER #### ' | |
| 98 | write(*,*) ' #### TRAJECTORIES, THE Z COORDINATE MUST BE #### ' | |
| 99 | write(*,*) ' #### GIVEN IN METERS ABOVE GROUND. #### ' | |
| 100 | error=.true. | |
| 101 | return | |
| 102 | endif | |
| 103 | ||
| 104 | ||
| 105 | isum=isum+1 | |
| 106 | if(isum.gt.maxpoint.or.isum*(numbunc+1).gt.maxpoint) then | |
| 107 | error=.true. | |
| 108 | write(*,*) '#### TRAJECTORY MODEL SUBROUTINE READPOINTS: '// | |
| 109 | & '#### ' | |
| 110 | write(*,*) '#### ERROR - TOO MANY STARTING POINTS '// | |
| 111 | & '#### ' | |
| 112 | write(*,*) '#### REDUCE NUMBER OF STARTING POINTS OR '// | |
| 113 | & '#### ' | |
| 114 | write(*,*) '#### CHANGE PARAMETERIZATION OF TRAJECTORY '// | |
| 115 | & '#### ' | |
| 116 | write(*,*) '#### MODEL !!! '// | |
| 117 | & '#### ' | |
| 118 | goto 25 | |
| 119 | endif | |
| 120 | xpoint(isum)=xhelp | |
| 121 | ypoint(isum)=yhelp | |
| 122 | kind(isum)=kindhelp | |
| 123 | kindz(isum)=kindzhelp | |
| 124 | zpoint(isum)=zhelp | |
| 125 | C Conversion from hPa to Pa, if z coordinate is given in pressure units | |
| 126 | if (kindz(isum).eq.3) zpoint(isum)=zpoint(isum)*100. | |
| 127 | compoint(isum)(1:40)=comhelp(1:40) | |
| 128 | goto 100 | |
| 129 | 1 format(1x,a17,i6,a28) | |
| 130 | 25 close(unitpoin) | |
| 131 | numpoint=isum | |
| 132 | ||
| 133 | if ((numpoint*(numbunc+1)*(abs(lentra)/interv+1)).gt.maxtra) then | |
| 134 | write(*,*) ' #### TRAJECTORY MODEL ERROR! MODEL CAN NOT #### ' | |
| 135 | write(*,*) ' #### KEEP SO MANY TRAJECTORIES IN MEMORY. #### ' | |
| 136 | write(*,1) ' #### MAXIMUM: ',maxtra,' #### | |
| 137 | + ' | |
| 138 | write(*,1) ' #### CURRENTLY: ',numpoint*(numbunc+1)*(abs(lentra) | |
| 139 | + /interv+1),' #### ' | |
| 140 | write(*,*) ' #### YOU HAVE 3 POSSIBILITIES: #### ' | |
| 141 | write(*,*) ' #### 1) REDUCE NUMBER OF STARTING POINTS #### ' | |
| 142 | write(*,*) ' #### (FILE "STARTPOINTS"). #### ' | |
| 143 | write(*,*) ' #### 2) REDUCE THE LENGTH OF AN INDIVIDUAL #### ' | |
| 144 | write(*,*) ' #### TRAJECTORY (FILE "COMMAND"). #### ' | |
| 145 | write(*,*) ' #### 3) INCREASE THE TIME INTERVAL BETWEEN #### ' | |
| 146 | write(*,*) ' #### TRAJECTORY STARTING TIMES (FILE #### ' | |
| 147 | write(*,*) ' #### "COMMAND"). #### ' | |
| 148 | error=.true. | |
| 149 | endif | |
| 150 | ||
| 151 | ||
| 152 | return | |
| 153 | ||
| 154 | 998 error=.true. | |
| 155 | write(*,*) '#### TRAJECTORY MODEL SUBROUTINE READPOINTS: '// | |
| 156 | & '#### ' | |
| 157 | write(*,*) '#### FATAL ERROR - FILE "STARTPOINTS" IS '// | |
| 158 | & '#### ' | |
| 159 | write(*,*) '#### CORRUPT. PLEASE CHECK YOUR INPUTS FOR '// | |
| 160 | & '#### ' | |
| 161 | write(*,*) '#### MISTAKES OR GET A NEW "STARTPOINTS"- '// | |
| 162 | & '#### ' | |
| 163 | write(*,*) '#### FILE ... '// | |
| 164 | & '#### ' | |
| 165 | return | |
| 166 | ||
| 167 | 999 error=.true. | |
| 168 | write(*,*) | |
| 169 | write(*,*) ' ###########################################'// | |
| 170 | & '###### ' | |
| 171 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE READPOINTS: ' | |
| 172 | write(*,*) | |
| 173 | write(*,*) ' FATAL ERROR - FILE CONTAINING TRAJECTORY ST'// | |
| 174 | & 'ARTING ' | |
| 175 | write(*,*) ' AND ENDING POINTS IS NOT AVAILABLE OR YOU A'// | |
| 176 | & 'RE NOT' | |
| 177 | write(*,*) ' PERMITTED FOR ANY ACCESS ' | |
| 178 | write(*,*) ' ###########################################'// | |
| 179 | & '###### ' | |
| 180 | ||
| 181 | return | |
| 182 | end |
| 0 | subroutine readwind(indj,n) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE READWIND * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1997-08-05 * | |
| 9 | * LAST UPDATE: ---------- * | |
| 10 | * Update: 1998-07-29, global fields allowed * | |
| 11 | * A. Stohl, G. Wotawa * | |
| 12 | * 2011-06, implemented reading of grib2 format* | |
| 13 | * analog to FLEXPART 8.22 routines * | |
| 14 | * * | |
| 15 | *********************************************************************** | |
| 16 | * * | |
| 17 | * DESCRIPTION: * | |
| 18 | * * | |
| 19 | * READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE * | |
| 20 | * INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE * | |
| 21 | * * | |
| 22 | * INPUT: * | |
| 23 | * indj indicates number of the wind field to be read in * | |
| 24 | * n temporal index for meteorological fields (1 to 3)* | |
| 25 | * * | |
| 26 | * IMPORTANT VARIABLES FROM COMMON BLOCK: * | |
| 27 | * * | |
| 28 | * wfname File name of data to be read in * | |
| 29 | * nxfield,ny,nuvz,nwz expected field dimensions * | |
| 30 | * nlev_ec number of vertical levels ecmwf model * | |
| 31 | * uu,vv,ww wind fields * | |
| 32 | * tt,qq temperature and specific humidity * | |
| 33 | * ps surface pressure * | |
| 34 | * * | |
| 35 | *********************************************************************** | |
| 36 | ||
| 37 | use GRIB_API | |
| 38 | ||
| 39 | include 'includepar' | |
| 40 | include 'includecom' | |
| 41 | ||
| 42 | !HSO parameters for grib_api | |
| 43 | integer ifile | |
| 44 | integer iret | |
| 45 | integer igrib | |
| 46 | integer gribVer,parCat,parNum,typSurf,valSurf,discipl | |
| 47 | integer gotGrid | |
| 48 | character*24 gribErrorMsg | |
| 49 | character*20 gribFunction | |
| 50 | !HSO end | |
| 51 | ||
| 52 | integer indj,i,j,k,n,levdiff2,ifield,iumax,iwmax,lunit | |
| 53 | integer ix,jy,induvz,indwz | |
| 54 | ||
| 55 | * VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING | |
| 56 | ||
| 57 | C dimension of isec2 at least (22+n), where n is the number of parallels or | |
| 58 | C meridians in a quasi-regular (reduced) Gaussian or lat/long grid | |
| 59 | ||
| 60 | C dimension of zsec2 at least (10+nn), where nn is the number of vertical | |
| 61 | C coordinate parameters | |
| 62 | ||
| 63 | integer isec0(2),isec1(56),isec2(22+nxmax+nymax),isec3(2) | |
| 64 | integer isec4(64),inbuff(jpack),ilen,iswap,ierr,iword | |
| 65 | real*4 nsss(0:nxmax-1,0:nymax-1),ewss(0:nxmax-1,0:nymax-1) | |
| 66 | real zsec2(60+2*nuvzmax),zsec3(2),zsec4(jpunp) | |
| 67 | real xaux,yaux,xaux0,yaux0 | |
| 68 | real*8 xauxin,yauxin | |
| 69 | real ylat,xlon,wdummy,ffpol,ddpol,xlonr | |
| 70 | real uuaux,vvaux,uupolaux,vvpolaux | |
| 71 | ||
| 72 | character*1 yoper,opt | |
| 73 | logical error | |
| 74 | ||
| 75 | !HSO grib api error messages | |
| 76 | data gribErrorMsg/'Error reading grib file'/ | |
| 77 | data gribFunction/'readwind'/ | |
| 78 | ||
| 79 | data yoper/'D'/ | |
| 80 | ||
| 81 | levdiff2=nlev_ec-nwz+1 | |
| 82 | iumax=0 | |
| 83 | iwmax=0 | |
| 84 | * | |
| 85 | * OPENING OF DATA FILE (GRIB CODE) | |
| 86 | * | |
| 87 | ||
| 88 | 5 call grib_open_file(ifile,path(3)(1:len(3)) | |
| 89 | >//trim(wfname(indj)),'r',iret) | |
| 90 | if (iret.ne.GRIB_SUCCESS) then | |
| 91 | goto 888 ! ERROR DETECTED | |
| 92 | endif | |
| 93 | ||
| 94 | gotGrid=0 | |
| 95 | ifield=0 | |
| 96 | 10 ifield=ifield+1 | |
| 97 | * | |
| 98 | * GET NEXT FIELDS | |
| 99 | * | |
| 100 | call grib_new_from_file(ifile,igrib,iret) | |
| 101 | if (iret.eq.GRIB_END_OF_FILE) then | |
| 102 | goto 50 ! EOF DETECTED | |
| 103 | elseif (iret.ne.GRIB_SUCCESS) then | |
| 104 | goto 888 ! ERROR DETECTED | |
| 105 | endif | |
| 106 | ||
| 107 | ! first see if we read GRIB1 or GRIB2 | |
| 108 | call grib_get_int(igrib,'editionNumber',gribVer,iret) | |
| 109 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 110 | ||
| 111 | if (gribVer.eq.1) then ! GRIB Edition 1 | |
| 112 | c print*,'GRiB Edition 1' | |
| 113 | c read the grib2 identifiers | |
| 114 | call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret) | |
| 115 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 116 | call grib_get_int(igrib,'level',isec1(8),iret) | |
| 117 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 118 | ||
| 119 | c change code for etadot to code for omega | |
| 120 | if (isec1(6).eq.77) then | |
| 121 | isec1(6)=135 | |
| 122 | endif | |
| 123 | else | |
| 124 | c print*,'GRiB Edition 2' | |
| 125 | c read the grib2 identifiers | |
| 126 | call grib_get_int(igrib,'discipline',discipl,iret) | |
| 127 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 128 | call grib_get_int(igrib,'parameterCategory',parCat,iret) | |
| 129 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 130 | call grib_get_int(igrib,'parameterNumber',parNum,iret) | |
| 131 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 132 | call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret) | |
| 133 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 134 | call grib_get_int(igrib,'level',valSurf,iret) | |
| 135 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 136 | ! convert to grib1 identifiers | |
| 137 | isec1(6)=-1 | |
| 138 | isec1(7)=-1 | |
| 139 | isec1(8)=-1 | |
| 140 | isec1(8)=valSurf ! level | |
| 141 | if((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105))then ! T | |
| 142 | isec1(6)=130 ! indicatorOfParameter | |
| 143 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105))then ! U | |
| 144 | isec1(6)=131 ! indicatorOfParameter | |
| 145 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105))then ! V | |
| 146 | isec1(6)=132 ! indicatorOfParameter | |
| 147 | elseif((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105))then ! Q | |
| 148 | isec1(6)=133 ! indicatorOfParameter | |
| 149 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1))then !SP | |
| 150 | isec1(6)=134 ! indicatorOfParameter | |
| 151 | elseif((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot | |
| 152 | isec1(6)=135 ! indicatorOfParameter | |
| 153 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101))then !SLP | |
| 154 | isec1(6)=151 ! indicatorOfParameter | |
| 155 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103))then ! 10U | |
| 156 | isec1(6)=165 ! indicatorOfParamete | |
| 157 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103))then ! 10V | |
| 158 | isec1(6)=166 ! indicatorOfParameter | |
| 159 | elseif((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103))then ! 2T | |
| 160 | isec1(6)=167 ! indicatorOfParameter | |
| 161 | elseif((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103))then ! 2D | |
| 162 | isec1(6)=168 ! indicatorOfParameter | |
| 163 | elseif((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1))then ! SD | |
| 164 | isec1(6)=141 ! indicatorOfParameter | |
| 165 | elseif((parCat.eq.6).and.(parNum.eq.1)) then ! CC | |
| 166 | isec1(6)=164 ! indicatorOfParameter | |
| 167 | elseif((parCat.eq.1).and.(parNum.eq.9)) then ! LSP | |
| 168 | isec1(6)=142 ! indicatorOfParameter | |
| 169 | elseif((parCat.eq.1).and.(parNum.eq.10)) then ! CP | |
| 170 | isec1(6)=143 ! indicatorOfParameter | |
| 171 | elseif((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1))then ! SHF | |
| 172 | isec1(6)=146 ! indicatorOfParameter | |
| 173 | elseif((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1))then ! SR | |
| 174 | isec1(6)=176 ! indicatorOfParameter | |
| 175 | elseif((parCat.eq.2).and.(parNum.eq.17)) then ! EWSS | |
| 176 | isec1(6)=180 ! indicatorOfParameter | |
| 177 | elseif((parCat.eq.2).and.(parNum.eq.18)) then ! NSSS | |
| 178 | isec1(6)=181 ! indicatorOfParameter | |
| 179 | elseif((parCat.eq.3).and.(parNum.eq.4)) then ! ORO | |
| 180 | isec1(6)=129 ! indicatorOfParameter | |
| 181 | elseif((parCat.eq.3).and.(parNum.eq.7)) then ! SDO | |
| 182 | isec1(6)=160 ! indicatorOfParameter | |
| 183 | elseif((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. | |
| 184 | + (typSurf.eq.1)) then ! LSM | |
| 185 | isec1(6)=172 ! indicatorOfParameter | |
| 186 | else | |
| 187 | print*,'***ERROR: undefined GRiB2 message found!',discipl, | |
| 188 | + parCat,parNum,typSurf | |
| 189 | endif | |
| 190 | endif | |
| 191 | ||
| 192 | !HSO get the size and data of the values array | |
| 193 | if (isec1(6).ne.-1) then | |
| 194 | call grib_get_real4_array(igrib,'values',zsec4,iret) | |
| 195 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 196 | endif | |
| 197 | ||
| 198 | !HSO get the required fields from section 2 in a gribex compatible manner | |
| 199 | if (ifield.eq.1) then | |
| 200 | call grib_get_int(igrib,'numberOfPointsAlongAParallel', | |
| 201 | + isec2(2),iret) | |
| 202 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 203 | call grib_get_int(igrib,'numberOfPointsAlongAMeridian', | |
| 204 | + isec2(3),iret) | |
| 205 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 206 | call grib_get_int(igrib,'numberOfVerticalCoordinateValues', | |
| 207 | + isec2(12)) | |
| 208 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 209 | * CHECK GRID SPECIFICATIONS | |
| 210 | if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT' | |
| 211 | if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT' | |
| 212 | if(isec2(12)/2-1.ne.nlev_ec) | |
| 213 | + stop 'READWIND: VERTICAL DISCRETIZATION NOT CONSISTENT' | |
| 214 | endif ! ifield | |
| 215 | ||
| 216 | !HSO get the second part of the grid dimensions only from GRiB1 messages | |
| 217 | if ((gribVer.eq.1).and.(gotGrid.eq.0)) then | |
| 218 | call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', | |
| 219 | > xauxin,iret) | |
| 220 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 221 | call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', | |
| 222 | > yauxin,iret) | |
| 223 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 224 | xaux=xauxin | |
| 225 | yaux=yauxin | |
| 226 | xaux0=xlon0 | |
| 227 | yaux0=ylat0 | |
| 228 | if(xaux.lt.0.) xaux=xaux+360. | |
| 229 | if(yaux.lt.0.) yaux=yaux+360. | |
| 230 | if(xaux0.lt.0.) xaux0=xaux0+360. | |
| 231 | if(yaux0.lt.0.) yaux0=yaux0+360. | |
| 232 | if(abs(xaux-xaux0).gt.eps) | |
| 233 | & stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT' | |
| 234 | if(abs(yaux-yaux0).gt.eps) | |
| 235 | & stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT' | |
| 236 | gotGrid=1 | |
| 237 | endif ! gotGrid | |
| 238 | ||
| 239 | do 20 j=0,ny-1 | |
| 240 | do 20 i=0,nxfield-1 | |
| 241 | k=isec1(8) | |
| 242 | if(isec1(6).eq.130) tt(i,j,nlev_ec-k+1,n)= !! TEMPERATURE | |
| 243 | & zsec4(nxfield*(ny-j-1)+i+1) | |
| 244 | if(isec1(6).eq.131) uu(i,j,nlev_ec-k+1,n)= !! U VELOCITY | |
| 245 | & zsec4(nxfield*(ny-j-1)+i+1) | |
| 246 | if(isec1(6).eq.132) vv(i,j,nlev_ec-k+1,n)= !! V VELOCITY | |
| 247 | & zsec4(nxfield*(ny-j-1)+i+1) | |
| 248 | if(isec1(6).eq.133) then | |
| 249 | qq(i,j,nlev_ec-k+1,n)= !! SPEC. HUMIDITY | |
| 250 | & zsec4(nxfield*(ny-j-1)+i+1) | |
| 251 | if (qq(i,j,nlev_ec-k+1,n).lt.0.) qq(i,j,nlev_ec-k+1,n)=0. | |
| 252 | c this is necessary because the gridded data may contain | |
| 253 | c spurious negative values | |
| 254 | endif | |
| 255 | if(isec1(6).eq.134) ps(i,j,1,n)= !! SURF. PRESS. | |
| 256 | & zsec4(nxfield*(ny-j-1)+i+1) | |
| 257 | if(isec1(6).eq.135) ww(i,j,nlev_ec-k+1,n)= !! W VELOCITY | |
| 258 | & zsec4(nxfield*(ny-j-1)+i+1) | |
| 259 | if(isec1(6).eq.129) oro(i,j)= !! ECMWF OROGRAPHY | |
| 260 | & zsec4(nxfield*(ny-j-1)+i+1)/ga | |
| 261 | if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1) | |
| 262 | if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1) | |
| 263 | ||
| 264 | 20 continue | |
| 265 | ||
| 266 | call grib_release(igrib) | |
| 267 | goto 10 !! READ NEXT LEVEL OR PARAMETER | |
| 268 | * | |
| 269 | * CLOSING OF INPUT DATA FILE | |
| 270 | * | |
| 271 | 50 call grib_close_file(ifile) | |
| 272 | ||
| 273 | * error message if no fields found with correct first longitude in it | |
| 274 | if (gotGrid.eq.0) then | |
| 275 | print*,'***ERROR: input file needs to contain GRiB1 formatted'// | |
| 276 | &'messages' | |
| 277 | stop | |
| 278 | endif | |
| 279 | ||
| 280 | if(levdiff2.eq.0) then | |
| 281 | iwmax=nlev_ec+1 | |
| 282 | do 60 j=0,ny-1 | |
| 283 | do 60 i=0,nx-1 | |
| 284 | 60 ww(i,j,nlev_ec+1,n)=0. | |
| 285 | endif | |
| 286 | ||
| 287 | ||
| 288 | C For global fields, assign rightmost grid point the value of the | |
| 289 | C leftmost point | |
| 290 | ***************************************************************** | |
| 291 | ||
| 292 | if (xglobal) then | |
| 293 | do 70 j=0,ny-1 | |
| 294 | oro(nx-1,j)=oro(0,j) | |
| 295 | ps(nx-1,j,1,n)=ps(0,j,1,n) | |
| 296 | do 71 induvz=1,nuvz | |
| 297 | tt(nx-1,j,induvz,n)=tt(0,j,induvz,n) | |
| 298 | qq(nx-1,j,induvz,n)=qq(0,j,induvz,n) | |
| 299 | uu(nx-1,j,induvz,n)=uu(0,j,induvz,n) | |
| 300 | 71 vv(nx-1,j,induvz,n)=vv(0,j,induvz,n) | |
| 301 | do 70 indwz=1,nwz | |
| 302 | 70 ww(nx-1,j,indwz,n)=ww(0,j,indwz,n) | |
| 303 | endif | |
| 304 | ||
| 305 | ||
| 306 | C If north pole is in the domain, calculate wind velocities in polar | |
| 307 | C stereographic coordinates | |
| 308 | ******************************************************************** | |
| 309 | ||
| 310 | if (nglobal) then | |
| 311 | do 74 jy=int(switchnorthg)-2,ny-1 | |
| 312 | ylat=ylat0+float(jy)*dy | |
| 313 | do 74 ix=0,nx-1 | |
| 314 | xlon=xlon0+float(ix)*dx | |
| 315 | do 74 induvz=1,nuvz | |
| 316 | 74 call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,induvz,n), | |
| 317 | + vv(ix,jy,induvz,n),uupol(ix,jy,induvz,n), | |
| 318 | + vvpol(ix,jy,induvz,n)) | |
| 319 | ||
| 320 | ||
| 321 | do 76 induvz=1,nuvz | |
| 322 | ||
| 323 | * CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT | |
| 324 | xlon=xlon0+float(nx/2-1)*dx | |
| 325 | xlonr=xlon*pi/180. | |
| 326 | ffpol=sqrt(uu(nx/2-1,ny-1,induvz,n)**2+ | |
| 327 | & vv(nx/2-1,ny-1,induvz,n)**2) | |
| 328 | if(vv(nx/2-1,ny-1,induvz,n).lt.0.) then | |
| 329 | ddpol=atan(uu(nx/2-1,ny-1,induvz,n)/ | |
| 330 | & vv(nx/2-1,ny-1,induvz,n))-xlonr | |
| 331 | else | |
| 332 | ddpol=pi+atan(uu(nx/2-1,ny-1,induvz,n)/ | |
| 333 | & vv(nx/2-1,ny-1,induvz,n))-xlonr | |
| 334 | endif | |
| 335 | if(ddpol.lt.0.) ddpol=2.0*pi+ddpol | |
| 336 | if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi | |
| 337 | ||
| 338 | * CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID | |
| 339 | xlon=180.0 | |
| 340 | xlonr=xlon*pi/180. | |
| 341 | ylat=90.0 | |
| 342 | uuaux=-ffpol*sin(xlonr+ddpol) | |
| 343 | vvaux=-ffpol*cos(xlonr+ddpol) | |
| 344 | call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, | |
| 345 | + vvpolaux) | |
| 346 | ||
| 347 | jy=ny-1 | |
| 348 | do 76 ix=0,nx-1 | |
| 349 | uupol(ix,jy,induvz,n)=uupolaux | |
| 350 | vvpol(ix,jy,induvz,n)=vvpolaux | |
| 351 | 76 continue | |
| 352 | ||
| 353 | ||
| 354 | * Fix: Set W at pole to the zonally averaged W of the next equator- | |
| 355 | * ward parallel of latitude | |
| 356 | ||
| 357 | do 85 indwz=1,nwz | |
| 358 | wdummy=0. | |
| 359 | jy=ny-2 | |
| 360 | do 80 ix=0,nx-1 | |
| 361 | 80 wdummy=wdummy+ww(ix,jy,indwz,n) | |
| 362 | wdummy=wdummy/float(nx) | |
| 363 | jy=ny-1 | |
| 364 | do 85 ix=0,nx-1 | |
| 365 | 85 ww(ix,jy,indwz,n)=wdummy | |
| 366 | ||
| 367 | endif | |
| 368 | ||
| 369 | C If south pole is in the domain, calculate wind velocities in polar | |
| 370 | C stereographic coordinates | |
| 371 | ******************************************************************** | |
| 372 | ||
| 373 | if (sglobal) then | |
| 374 | do 77 jy=0,int(switchsouthg)+3 | |
| 375 | ylat=ylat0+float(jy)*dy | |
| 376 | do 77 ix=0,nx-1 | |
| 377 | xlon=xlon0+float(ix)*dx | |
| 378 | do 77 induvz=1,nuvz | |
| 379 | 77 call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,induvz,n), | |
| 380 | + vv(ix,jy,induvz,n),uupol(ix,jy,induvz,n), | |
| 381 | + vvpol(ix,jy,induvz,n)) | |
| 382 | ||
| 383 | do 79 induvz=1,nuvz | |
| 384 | ||
| 385 | * CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT | |
| 386 | xlon=xlon0+float(nx/2-1)*dx | |
| 387 | xlonr=xlon*pi/180. | |
| 388 | ffpol=sqrt(uu(nx/2-1,0,induvz,n)**2+ | |
| 389 | & vv(nx/2-1,0,induvz,n)**2) | |
| 390 | if(vv(nx/2-1,0,induvz,n).lt.0.) then | |
| 391 | ddpol=atan(uu(nx/2-1,0,induvz,n)/ | |
| 392 | & vv(nx/2-1,0,induvz,n))+xlonr | |
| 393 | else | |
| 394 | ddpol=pi+atan(uu(nx/2-1,0,induvz,n)/ | |
| 395 | & vv(nx/2-1,0,induvz,n))+xlonr | |
| 396 | endif | |
| 397 | if(ddpol.lt.0.) ddpol=2.0*pi+ddpol | |
| 398 | if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi | |
| 399 | ||
| 400 | * CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID | |
| 401 | xlon=180.0 | |
| 402 | xlonr=xlon*pi/180. | |
| 403 | ylat=-90.0 | |
| 404 | uuaux=+ffpol*sin(xlonr-ddpol) | |
| 405 | vvaux=-ffpol*cos(xlonr-ddpol) | |
| 406 | call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, | |
| 407 | + vvpolaux) | |
| 408 | ||
| 409 | jy=0 | |
| 410 | do 79 ix=0,nx-1 | |
| 411 | uupol(ix,jy,induvz,n)=uupolaux | |
| 412 | 79 vvpol(ix,jy,induvz,n)=vvpolaux | |
| 413 | ||
| 414 | ||
| 415 | * Fix: Set W at pole to the zonally averaged W of the next equator- | |
| 416 | * ward parallel of latitude | |
| 417 | ||
| 418 | do 95 indwz=1,nwz | |
| 419 | wdummy=0. | |
| 420 | jy=1 | |
| 421 | do 90 ix=0,nx-1 | |
| 422 | 90 wdummy=wdummy+ww(ix,jy,indwz,n) | |
| 423 | wdummy=wdummy/float(nx) | |
| 424 | jy=0 | |
| 425 | do 95 ix=0,nx-1 | |
| 426 | 95 ww(ix,jy,indwz,n)=wdummy | |
| 427 | endif | |
| 428 | ||
| 429 | if(iumax.ne.nuvz) stop 'READWIND: NUVZ NOT CONSISTENT' | |
| 430 | if(iwmax.ne.nwz) stop 'READWIND: NWZ NOT CONSISTENT' | |
| 431 | ||
| 432 | ||
| 433 | C Calculate potential temperature and potential vorticity on whole grid | |
| 434 | *********************************************************************** | |
| 435 | ||
| 436 | call calcpv(n) | |
| 437 | ||
| 438 | ||
| 439 | return | |
| 440 | 888 write(*,*) ' #### TRAJECTORY MODEL ERROR! WINDFIELD #### ' | |
| 441 | write(*,*) ' #### ',wfname(indj),' #### ' | |
| 442 | write(*,*) ' #### IS NOT GRIB FORMAT !!! #### ' | |
| 443 | stop 'Execution terminated' | |
| 444 | ||
| 445 | 999 write(*,*) ' #### TRAJECTORY MODEL ERROR! WINDFIELD #### ' | |
| 446 | write(*,*) ' #### ',wfname(indj),' #### ' | |
| 447 | write(*,*) ' #### CANNOT BE OPENED !!! #### ' | |
| 448 | write(*,*) | |
| 449 | write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND !!!' | |
| 450 | write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE... !!!' | |
| 451 | write(*,'(a)') '!!! ...OR TERMINATE FLEXTRA PRESSING !!!' | |
| 452 | write(*,'(a)') '!!! THE "X" KEY... !!!' | |
| 453 | write(*,'(a)') '!!! PLEASE CHECK CD-ROM LABEL AND !!!' | |
| 454 | write(*,'(a)') '!!! CORRECT FILE "PATHNAMES"... !!!' | |
| 455 | write(*,*) | |
| 456 | read(*,'(a)') opt | |
| 457 | if(opt.eq.'X') then | |
| 458 | stop 'Execution terminated' | |
| 459 | else | |
| 460 | call readpaths(error) | |
| 461 | if(error) | |
| 462 | & stop 'Error reading "pathnames" --> execution terminated' | |
| 463 | goto 5 | |
| 464 | endif | |
| 465 | ||
| 466 | end |
| 0 | subroutine readwind(indj,n) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE READWIND * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1997-08-05 * | |
| 9 | * LAST UPDATE: ---------- * | |
| 10 | * Update: 1998-07-29, global fields allowed * | |
| 11 | * A. Stohl, G. Wotawa * | |
| 12 | * Update: 2001-01-05 NCEP Data Pressure levels * | |
| 13 | * * | |
| 14 | *********************************************************************** | |
| 15 | * * | |
| 16 | * DESCRIPTION: * | |
| 17 | * * | |
| 18 | * READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE * | |
| 19 | * INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE * | |
| 20 | * * | |
| 21 | * INPUT: * | |
| 22 | * indj indicates number of the wind field to be read in * | |
| 23 | * n temporal index for meteorological fields (1 to 3)* | |
| 24 | * * | |
| 25 | * IMPORTANT VARIABLES FROM COMMON BLOCK: * | |
| 26 | * * | |
| 27 | * wfname File name of data to be read in * | |
| 28 | * nxfield,ny,nuvz,nwz expected field dimensions * | |
| 29 | * nlev_ec number of vertical levels ecmwf model * | |
| 30 | * uu,vv,ww wind fields * | |
| 31 | * tt,qq temperature and specific humidity * | |
| 32 | * ps surface pressure * | |
| 33 | * * | |
| 34 | *********************************************************************** | |
| 35 | ||
| 36 | include 'includepar' | |
| 37 | include 'includecom' | |
| 38 | include 'grib_api_f77.h' | |
| 39 | ||
| 40 | integer ii,indj,i,j,k,n,ifield,iumax | |
| 41 | integer ix,jy,induvz,indwz,numpt,numpu,numpv,numpw,numprh | |
| 42 | real help,temp,plev,ew,elev | |
| 43 | ||
| 44 | * VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING | |
| 45 | ||
| 46 | C dimension of isec2 at least (22+n), where n is the number of parallels or | |
| 47 | C meridians in a quasi-regular (reduced) Gaussian or lat/long grid | |
| 48 | ||
| 49 | C dimension of zsec2 at least (10+nn), where nn is the number of vertical | |
| 50 | C coordinate parameters | |
| 51 | ||
| 52 | integer isec1(56),isec2(22+nxmax+nymax) | |
| 53 | real zsec4(jpunp) | |
| 54 | real xaux,yaux,xaux0,yaux0 | |
| 55 | real ylat,xlon,wdummy,ffpol,ddpol,xlonr | |
| 56 | real uuaux,vvaux,uupolaux,vvpolaux | |
| 57 | ||
| 58 | logical error | |
| 59 | ||
| 60 | ! parameters for grib_api | |
| 61 | integer ifile | |
| 62 | integer iret | |
| 63 | integer igrib | |
| 64 | integer*4 isize | |
| 65 | integer gribVer,parCat,parNum,typSurf,valSurf | |
| 66 | real*8 zsecn4(jpunp*4) | |
| 67 | real*8 xauxin,yauxin | |
| 68 | ||
| 69 | integer i179,i180,i181 | |
| 70 | ||
| 71 | iumax=0 | |
| 72 | * | |
| 73 | * OPENING OF DATA FILE (GRIB CODE) | |
| 74 | * | |
| 75 | * | |
| 76 | * OPENING OF DATA FILE (GRIB CODE) | |
| 77 | * | |
| 78 | !HSO | |
| 79 | ! print*,'reading winds from ',path(3)(1:len(3)) | |
| 80 | ! >//trim(wfname(indj)),'|' | |
| 81 | 5 iret=grib_open_file(ifile,path(3)(1:len(3)) | |
| 82 | >//trim(wfname(indj)),'r') | |
| 83 | call grib_check(iret) | |
| 84 | ! turn on support for multi fields messages | |
| 85 | call grib_check(grib_multi_support_on()) | |
| 86 | ||
| 87 | ||
| 88 | numpt=0 | |
| 89 | numpu=0 | |
| 90 | numpv=0 | |
| 91 | numpw=0 | |
| 92 | numprh=0 | |
| 93 | ifield=0 | |
| 94 | 10 ifield=ifield+1 | |
| 95 | * | |
| 96 | * GET NEXT FIELDS | |
| 97 | * | |
| 98 | ||
| 99 | iret=grib_new_from_file(ifile,igrib) | |
| 100 | if (igrib .eq. -1 ) then | |
| 101 | if (iret .ne. -1) then | |
| 102 | call grib_check(iret) | |
| 103 | goto 888 ! ERROR DETECTED | |
| 104 | endif | |
| 105 | goto 50 ! EOF DETECTED | |
| 106 | endif | |
| 107 | ||
| 108 | ! first see if we read GRIB1 or GRIB2 | |
| 109 | call grib_check(grib_get_int( igrib, | |
| 110 | >'editionNumber',gribVer)) | |
| 111 | ||
| 112 | ! get the size and data of the values array | |
| 113 | call grib_check(grib_get_size(igrib,'values',isize)) | |
| 114 | call grib_check(grib_get_real8_array(igrib,'values',zsecn4,isize)) | |
| 115 | do i=1,isize | |
| 116 | zsec4(i)=zsecn4(i) | |
| 117 | enddo | |
| 118 | ||
| 119 | if (gribVer.eq.1) then ! GRIB Edition 1 | |
| 120 | ||
| 121 | ! read the grib1 identifiers | |
| 122 | call grib_check(grib_get_int( igrib, | |
| 123 | >'indicatorOfParameter',isec1(6))) | |
| 124 | call grib_check(grib_get_int( igrib, | |
| 125 | >'indicatorOfTypeOfLevel',isec1(7))) | |
| 126 | call grib_check(grib_get_int( igrib, | |
| 127 | >'level',isec1(8))) | |
| 128 | ||
| 129 | else ! GRIB Edition 2 | |
| 130 | ||
| 131 | ! read the grib2 identifiers | |
| 132 | call grib_check(grib_get_int( igrib, | |
| 133 | >'parameterCategory',parCat)) | |
| 134 | call grib_check(grib_get_int( igrib, | |
| 135 | >'parameterNumber',parNum)) | |
| 136 | call grib_check(grib_get_int( igrib, | |
| 137 | >'typeOfFirstFixedSurface',typSurf)) | |
| 138 | call grib_check(grib_get_int( igrib, | |
| 139 | >'scaledValueOfFirstFixedSurface',valSurf)) | |
| 140 | ||
| 141 | ! convert to grib1 identifiers | |
| 142 | isec1(6)=-1 | |
| 143 | isec1(7)=-1 | |
| 144 | isec1(8)=-1 | |
| 145 | if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.100)) then ! T | |
| 146 | isec1(6)=11 ! indicatorOfParameter | |
| 147 | isec1(7)=100 ! indicatorOfTypeOfLevel | |
| 148 | isec1(8)=valSurf/100 ! level, convert to hPa | |
| 149 | elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.100)) then ! U | |
| 150 | isec1(6)=33 ! indicatorOfParameter | |
| 151 | isec1(7)=100 ! indicatorOfTypeOfLevel | |
| 152 | isec1(8)=valSurf/100 ! level, convert to hPa | |
| 153 | elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.100)) then ! V | |
| 154 | isec1(6)=34 ! indicatorOfParameter | |
| 155 | isec1(7)=100 ! indicatorOfTypeOfLevel | |
| 156 | isec1(8)=valSurf/100 ! level, convert to hPa | |
| 157 | elseif ((parCat.eq.2).and.(parNum.eq.8).and.(typSurf.eq.100)) then ! W | |
| 158 | isec1(6)=39 ! indicatorOfParameter | |
| 159 | isec1(7)=100 ! indicatorOfTypeOfLevel | |
| 160 | isec1(8)=valSurf/100 ! level, convert to hPa | |
| 161 | elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSurf.eq.100)) then ! RH | |
| 162 | isec1(6)=52 ! indicatorOfParameter | |
| 163 | isec1(7)=100 ! indicatorOfTypeOfLevel | |
| 164 | isec1(8)=valSurf/100 ! level, convert to hPa | |
| 165 | elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSurf.eq.103)) then ! RH2 | |
| 166 | isec1(6)=52 ! indicatorOfParameter | |
| 167 | isec1(7)=105 ! indicatorOfTypeOfLevel | |
| 168 | isec1(8)=2 | |
| 169 | elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! T2 | |
| 170 | isec1(6)=11 ! indicatorOfParameter | |
| 171 | isec1(7)=105 ! indicatorOfTypeOfLevel | |
| 172 | isec1(8)=2 | |
| 173 | elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! U10 | |
| 174 | isec1(6)=33 ! indicatorOfParameter | |
| 175 | isec1(7)=105 ! indicatorOfTypeOfLevel | |
| 176 | isec1(8)=10 | |
| 177 | elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! V10 | |
| 178 | isec1(6)=34 ! indicatorOfParameter | |
| 179 | isec1(7)=105 ! indicatorOfTypeOfLevel | |
| 180 | isec1(8)=10 | |
| 181 | elseif ((parCat.eq.3).and.(parNum.eq.1).and.(typSurf.eq.101)) then ! SLP | |
| 182 | isec1(6)=2 ! indicatorOfParameter | |
| 183 | isec1(7)=102 ! indicatorOfTypeOfLevel | |
| 184 | isec1(8)=0 | |
| 185 | elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then ! SP | |
| 186 | isec1(6)=1 ! indicatorOfParameter | |
| 187 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 188 | isec1(8)=0 | |
| 189 | elseif ((parCat.eq.1).and.(parNum.eq.13).and.(typSurf.eq.1)) then ! SNOW | |
| 190 | isec1(6)=66 ! indicatorOfParameter | |
| 191 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 192 | isec1(8)=0 | |
| 193 | elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.104)) then ! T sigma 0 | |
| 194 | isec1(6)=11 ! indicatorOfParameter | |
| 195 | isec1(7)=107 ! indicatorOfTypeOfLevel | |
| 196 | isec1(8)=0.995 ! lowest sigma level | |
| 197 | elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.104)) then ! U sigma 0 | |
| 198 | isec1(6)=33 ! indicatorOfParameter | |
| 199 | isec1(7)=107 ! indicatorOfTypeOfLevel | |
| 200 | isec1(8)=0.995 ! lowest sigma level | |
| 201 | elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.104)) then ! V sigma 0 | |
| 202 | isec1(6)=34 ! indicatorOfParameter | |
| 203 | isec1(7)=107 ! indicatorOfTypeOfLevel | |
| 204 | isec1(8)=0.995 ! lowest sigma level | |
| 205 | elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSurf.eq.1)) then ! TOPO | |
| 206 | isec1(6)=7 ! indicatorOfParameter | |
| 207 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 208 | isec1(8)=0 | |
| 209 | elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.1)) then ! LSM | |
| 210 | isec1(6)=81 ! indicatorOfParameter | |
| 211 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 212 | isec1(8)=0 | |
| 213 | elseif ((parCat.eq.3).and.(parNum.eq.196).and.(typSurf.eq.1)) then ! BLH | |
| 214 | isec1(6)=221 ! indicatorOfParameter | |
| 215 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 216 | isec1(8)=0 | |
| 217 | elseif ((parCat.eq.1).and.(parNum.eq.7).and.(typSurf.eq.1)) then ! LSP/TP | |
| 218 | isec1(6)=62 ! indicatorOfParameter | |
| 219 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 220 | isec1(8)=0 | |
| 221 | elseif ((parCat.eq.1).and.(parNum.eq.196).and.(typSurf.eq.1)) then ! CP | |
| 222 | isec1(6)=63 ! indicatorOfParameter | |
| 223 | isec1(7)=1 ! indicatorOfTypeOfLevel | |
| 224 | isec1(8)=0 | |
| 225 | endif | |
| 226 | ||
| 227 | endif ! gribVer | |
| 228 | ||
| 229 | ||
| 230 | C Check whether we are on a little endian or on a big endian computer | |
| 231 | ********************************************************************* | |
| 232 | ||
| 233 | c if (inbuff(1).eq.1112101447) then ! little endian, swap bytes | |
| 234 | c iswap=1+ilen/4 | |
| 235 | c call swap32(inbuff,iswap) | |
| 236 | c else if (inbuff(1).ne.1196575042) then ! big endian | |
| 237 | c stop 'subroutine gridcheck: corrupt GRIB data' | |
| 238 | c endif | |
| 239 | ||
| 240 | c if (ierr.ne.0) goto 10 ! ERROR DETECTED | |
| 241 | ||
| 242 | if(ifield.eq.1) then | |
| 243 | ||
| 244 | ! get the required fields from section 2 | |
| 245 | ! store compatible to gribex input | |
| 246 | call grib_check(grib_get_int( igrib, | |
| 247 | >'numberOfPointsAlongAParallel',isec2(2))) | |
| 248 | call grib_check(grib_get_int( igrib, | |
| 249 | >'numberOfPointsAlongAMeridian',isec2(3))) | |
| 250 | call grib_check(grib_get_real8(igrib, | |
| 251 | >'longitudeOfFirstGridPointInDegrees',xauxin)) | |
| 252 | call grib_check(grib_get_real8(igrib, | |
| 253 | >'latitudeOfLastGridPointInDegrees',yauxin)) | |
| 254 | xaux=xauxin | |
| 255 | yaux=yauxin | |
| 256 | ||
| 257 | * CHECK GRID SPECIFICATIONS | |
| 258 | ||
| 259 | if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT' | |
| 260 | if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT' | |
| 261 | if(xaux.eq.0.) xaux=-179.0 ! NCEP DATA | |
| 262 | xaux0=xlon0 | |
| 263 | yaux0=ylat0 | |
| 264 | if(xaux.lt.0.) xaux=xaux+360. | |
| 265 | if(yaux.lt.0.) yaux=yaux+360. | |
| 266 | if(xaux0.lt.0.) xaux0=xaux0+360. | |
| 267 | if(yaux0.lt.0.) yaux0=yaux0+360. | |
| 268 | if(abs(xaux-xaux0).gt.eps) | |
| 269 | & stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT' | |
| 270 | if(abs(yaux-yaux0).gt.eps) | |
| 271 | & stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT' | |
| 272 | endif | |
| 273 | !HSO end of edits | |
| 274 | ||
| 275 | i179=nint(179./dx) | |
| 276 | i180=nint(179./dx)+1 | |
| 277 | i181=i180+1 | |
| 278 | ||
| 279 | do 20 j=0,ny-1 | |
| 280 | do 20 i=0,nxfield-1 | |
| 281 | ||
| 282 | if((isec1(6).eq.011).and.(isec1(7).eq.100)) then | |
| 283 | * TEMPERATURE | |
| 284 | if((i.eq.0).and.(j.eq.0)) then | |
| 285 | do 21 ii=1,nuvz | |
| 286 | if ((isec1(8)*100.0).eq.akz(ii)) numpt=ii | |
| 287 | 21 continue | |
| 288 | endif | |
| 289 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 290 | if(i.le.i180) then | |
| 291 | tt(i179+i,j,numpt,n)=help | |
| 292 | else | |
| 293 | tt(i-i181,j,numpt,n)=help | |
| 294 | endif | |
| 295 | endif | |
| 296 | ||
| 297 | if((isec1(6).eq.033).and.(isec1(7).eq.100)) then | |
| 298 | * U VELOCITY | |
| 299 | if((i.eq.0).and.(j.eq.0)) then | |
| 300 | do 22 ii=1,nuvz | |
| 301 | if ((isec1(8)*100.0).eq.akz(ii)) numpu=ii | |
| 302 | 22 continue | |
| 303 | endif | |
| 304 | ||
| 305 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 306 | if(i.le.i180) then | |
| 307 | uu(i179+i,j,numpu,n)=help | |
| 308 | else | |
| 309 | uu(i-i181,j,numpu,n)=help | |
| 310 | endif | |
| 311 | endif | |
| 312 | ||
| 313 | if((isec1(6).eq.034).and.(isec1(7).eq.100)) then | |
| 314 | * V VELOCITY | |
| 315 | if((i.eq.0).and.(j.eq.0)) then | |
| 316 | do 23 ii=1,nuvz | |
| 317 | if ((isec1(8)*100.0).eq.akz(ii)) numpv=ii | |
| 318 | 23 continue | |
| 319 | endif | |
| 320 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 321 | if(i.le.i180) then | |
| 322 | vv(i179+i,j,numpv,n)=help | |
| 323 | else | |
| 324 | vv(i-i181,j,numpv,n)=help | |
| 325 | endif | |
| 326 | endif | |
| 327 | ||
| 328 | if((isec1(6).eq.039).and.(isec1(7).eq.100)) then | |
| 329 | * W VELOCITY | |
| 330 | if((i.eq.0).and.(j.eq.0)) then | |
| 331 | do 25 ii=1,nuvz | |
| 332 | if ((isec1(8)*100.0).eq.akz(ii)) numpw=ii | |
| 333 | 25 continue | |
| 334 | endif | |
| 335 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 336 | if(i.le.i180) then | |
| 337 | ww(i179+i,j,numpw,n)=help | |
| 338 | else | |
| 339 | ww(i-i181,j,numpw,n)=help | |
| 340 | endif | |
| 341 | endif | |
| 342 | ||
| 343 | if((isec1(6).eq.052).and.(isec1(7).eq.100)) then | |
| 344 | * RELATIVE HUMIDITY -> CONVERT TO SPECIFIC HUMIDITY | |
| 345 | if((i.eq.0).and.(j.eq.0)) then | |
| 346 | do 24 ii=1,nuvz | |
| 347 | if ((isec1(8)*100.0).eq.akz(ii)) numprh=ii | |
| 348 | 24 continue | |
| 349 | endif | |
| 350 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 351 | if(i.le.i180) then | |
| 352 | qq(i179+i,j,numprh,n)=help | |
| 353 | else | |
| 354 | qq(i-i181,j,numprh,n)=help | |
| 355 | endif | |
| 356 | endif | |
| 357 | ||
| 358 | if((isec1(6).eq.001).and.(isec1(7).eq.001)) then | |
| 359 | * SURFACE PRESSURE | |
| 360 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 361 | if(i.le.i180) then | |
| 362 | ps(i179+i,j,1,n)=help | |
| 363 | else | |
| 364 | ps(i-i181,j,1,n)=help | |
| 365 | endif | |
| 366 | endif | |
| 367 | ||
| 368 | if((isec1(6).eq.007).and.(isec1(7).eq.001)) then | |
| 369 | * TOPOGRAPHY | |
| 370 | help=zsec4(nxfield*(ny-j-1)+i+1) | |
| 371 | if(i.le.i180) then | |
| 372 | oro(i179+i,j)=help | |
| 373 | else | |
| 374 | oro(i-i181,j)=help | |
| 375 | endif | |
| 376 | endif | |
| 377 | ||
| 378 | 20 continue | |
| 379 | ||
| 380 | if((isec1(6).eq.33).and.(isec1(7).eq.100)) iumax=iumax+1 | |
| 381 | ||
| 382 | if (igrib.ne.-1) then | |
| 383 | call grib_check(grib_release(igrib)) | |
| 384 | endif | |
| 385 | ||
| 386 | goto 10 !! READ NEXT LEVEL OR PARAMETER | |
| 387 | ||
| 388 | 50 continue | |
| 389 | * | |
| 390 | * CLOSING OF INPUT DATA FILE | |
| 391 | * | |
| 392 | call grib_check(grib_close_file(ifile)) | |
| 393 | ||
| 394 | ||
| 395 | ||
| 396 | * TRANSFORM RH TO SPECIFIC HUMIDITY AS NEEDED | |
| 397 | ||
| 398 | do 65 j=0,ny-1 | |
| 399 | do 65 i=0,nxfield-1 | |
| 400 | do 65 k=1,nuvz | |
| 401 | help=qq(i,j,k,n) | |
| 402 | temp=tt(i,j,k,n) | |
| 403 | plev=akm(k) | |
| 404 | elev=ew(temp)*help/100.0 | |
| 405 | qq(i,j,k,n)=xmwml*(elev/(plev-((1.0-xmwml)*elev))) | |
| 406 | 65 continue | |
| 407 | ||
| 408 | C For global fields, assign rightmost grid point the value of the | |
| 409 | C leftmost point | |
| 410 | ***************************************************************** | |
| 411 | ||
| 412 | if (xglobal) then | |
| 413 | do 70 j=0,ny-1 | |
| 414 | oro(nx-1,j)=oro(0,j) | |
| 415 | ps(nx-1,j,1,n)=ps(0,j,1,n) | |
| 416 | do 71 induvz=1,nuvz | |
| 417 | tt(nx-1,j,induvz,n)=tt(0,j,induvz,n) | |
| 418 | qq(nx-1,j,induvz,n)=qq(0,j,induvz,n) | |
| 419 | uu(nx-1,j,induvz,n)=uu(0,j,induvz,n) | |
| 420 | 71 vv(nx-1,j,induvz,n)=vv(0,j,induvz,n) | |
| 421 | do 70 indwz=1,nwz | |
| 422 | 70 ww(nx-1,j,indwz,n)=ww(0,j,indwz,n) | |
| 423 | endif | |
| 424 | ||
| 425 | ||
| 426 | C If north pole is in the domain, calculate wind velocities in polar | |
| 427 | C stereographic coordinates | |
| 428 | ******************************************************************** | |
| 429 | ||
| 430 | if (nglobal) then | |
| 431 | do 74 jy=int(switchnorthg)-2,ny-1 | |
| 432 | ylat=ylat0+float(jy)*dy | |
| 433 | do 74 ix=0,nx-1 | |
| 434 | xlon=xlon0+float(ix)*dx | |
| 435 | do 74 induvz=1,nuvz | |
| 436 | 74 call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,induvz,n), | |
| 437 | + vv(ix,jy,induvz,n),uupol(ix,jy,induvz,n), | |
| 438 | + vvpol(ix,jy,induvz,n)) | |
| 439 | ||
| 440 | ||
| 441 | do 76 induvz=1,nuvz | |
| 442 | ||
| 443 | * CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT | |
| 444 | xlon=xlon0+float(nx/2-1)*dx | |
| 445 | xlonr=xlon*pi/180. | |
| 446 | ffpol=sqrt(uu(nx/2-1,ny-1,induvz,n)**2+ | |
| 447 | & vv(nx/2-1,ny-1,induvz,n)**2) | |
| 448 | if(vv(nx/2-1,ny-1,induvz,n).lt.0.) then | |
| 449 | if(vv(nx/2-1,ny-1,induvz,n).gt.-0.00001) | |
| 450 | & vv(nx/2-1,ny-1,induvz,n)=-0.00001 | |
| 451 | ddpol=atan(uu(nx/2-1,ny-1,induvz,n)/ | |
| 452 | & vv(nx/2-1,ny-1,induvz,n))-xlonr | |
| 453 | else | |
| 454 | if(vv(nx/2-1,ny-1,induvz,n).lt. 0.00001) | |
| 455 | & vv(nx/2-1,ny-1,induvz,n)= 0.00001 | |
| 456 | ddpol=pi+atan(uu(nx/2-1,ny-1,induvz,n)/ | |
| 457 | & vv(nx/2-1,ny-1,induvz,n))-xlonr | |
| 458 | endif | |
| 459 | if(ddpol.lt.0.) ddpol=2.0*pi+ddpol | |
| 460 | if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi | |
| 461 | ||
| 462 | * CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID | |
| 463 | xlon=180.0 | |
| 464 | xlonr=xlon*pi/180. | |
| 465 | ylat=90.0 | |
| 466 | uuaux=-ffpol*sin(xlonr+ddpol) | |
| 467 | vvaux=-ffpol*cos(xlonr+ddpol) | |
| 468 | call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, | |
| 469 | + vvpolaux) | |
| 470 | ||
| 471 | jy=ny-1 | |
| 472 | do 76 ix=0,nx-1 | |
| 473 | uupol(ix,jy,induvz,n)=uupolaux | |
| 474 | vvpol(ix,jy,induvz,n)=vvpolaux | |
| 475 | 76 continue | |
| 476 | ||
| 477 | ||
| 478 | * Fix: Set W at pole to the zonally averaged W of the next equator- | |
| 479 | * ward parallel of latitude | |
| 480 | ||
| 481 | do 85 indwz=1,nwz | |
| 482 | wdummy=0. | |
| 483 | jy=ny-2 | |
| 484 | do 80 ix=0,nx-1 | |
| 485 | 80 wdummy=wdummy+ww(ix,jy,indwz,n) | |
| 486 | wdummy=wdummy/float(nx) | |
| 487 | jy=ny-1 | |
| 488 | do 85 ix=0,nx-1 | |
| 489 | 85 ww(ix,jy,indwz,n)=wdummy | |
| 490 | ||
| 491 | endif | |
| 492 | ||
| 493 | C If south pole is in the domain, calculate wind velocities in polar | |
| 494 | C stereographic coordinates | |
| 495 | ******************************************************************** | |
| 496 | ||
| 497 | if (sglobal) then | |
| 498 | do 77 jy=0,int(switchsouthg)+3 | |
| 499 | ylat=ylat0+float(jy)*dy | |
| 500 | do 77 ix=0,nx-1 | |
| 501 | xlon=xlon0+float(ix)*dx | |
| 502 | do 77 induvz=1,nuvz | |
| 503 | 77 call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,induvz,n), | |
| 504 | + vv(ix,jy,induvz,n),uupol(ix,jy,induvz,n), | |
| 505 | + vvpol(ix,jy,induvz,n)) | |
| 506 | ||
| 507 | do 79 induvz=1,nuvz | |
| 508 | ||
| 509 | * CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT | |
| 510 | xlon=xlon0+float(nx/2-1)*dx | |
| 511 | xlonr=xlon*pi/180. | |
| 512 | ffpol=sqrt(uu(nx/2-1,0,induvz,n)**2+ | |
| 513 | & vv(nx/2-1,0,induvz,n)**2) | |
| 514 | if(vv(nx/2-1,0,induvz,n).lt.0.) then | |
| 515 | if(vv(nx/2-1,0,induvz,n).gt.-0.00001) | |
| 516 | & vv(nx/2-1,0,induvz,n)=-0.00001 | |
| 517 | ddpol=atan(uu(nx/2-1,0,induvz,n)/ | |
| 518 | & vv(nx/2-1,0,induvz,n))+xlonr | |
| 519 | else | |
| 520 | if(vv(nx/2-1,0,induvz,n).lt. 0.00001) | |
| 521 | & vv(nx/2-1,0,induvz,n)= 0.00001 | |
| 522 | ddpol=pi+atan(uu(nx/2-1,0,induvz,n)/ | |
| 523 | & vv(nx/2-1,0,induvz,n))+xlonr | |
| 524 | endif | |
| 525 | if(ddpol.lt.0.) ddpol=2.0*pi+ddpol | |
| 526 | if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi | |
| 527 | ||
| 528 | * CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID | |
| 529 | xlon=180.0 | |
| 530 | xlonr=xlon*pi/180. | |
| 531 | ylat=-90.0 | |
| 532 | uuaux=+ffpol*sin(xlonr-ddpol) | |
| 533 | vvaux=-ffpol*cos(xlonr-ddpol) | |
| 534 | call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, | |
| 535 | + vvpolaux) | |
| 536 | ||
| 537 | jy=0 | |
| 538 | do 79 ix=0,nx-1 | |
| 539 | uupol(ix,jy,induvz,n)=uupolaux | |
| 540 | 79 vvpol(ix,jy,induvz,n)=vvpolaux | |
| 541 | ||
| 542 | ||
| 543 | * Fix: Set W at pole to the zonally averaged W of the next equator- | |
| 544 | * ward parallel of latitude | |
| 545 | ||
| 546 | do 95 indwz=1,nwz | |
| 547 | wdummy=0. | |
| 548 | jy=1 | |
| 549 | do 90 ix=0,nx-1 | |
| 550 | 90 wdummy=wdummy+ww(ix,jy,indwz,n) | |
| 551 | wdummy=wdummy/float(nx) | |
| 552 | jy=0 | |
| 553 | do 95 ix=0,nx-1 | |
| 554 | 95 ww(ix,jy,indwz,n)=wdummy | |
| 555 | endif | |
| 556 | ||
| 557 | WRITE(*,*) WFTIME(INDJ),' SEC ',WFTIME(INDJ)/3600,' HRS ', | |
| 558 | +WFTIME(INDJ)/3600/24,' DAYS ', WFNAME(INDJ) | |
| 559 | if(iumax.ne.nuvz) stop 'READWIND: NUVZ NOT CONSISTENT' | |
| 560 | if(iumax.ne.nwz) stop 'READWIND: NWZ NOT CONSISTENT' | |
| 561 | ||
| 562 | ||
| 563 | C Calculate potential temperature and potential vorticity on whole grid | |
| 564 | *********************************************************************** | |
| 565 | ||
| 566 | call calcpv(n) | |
| 567 | ||
| 568 | ||
| 569 | return | |
| 570 | 888 write(*,*) ' #### TRAJECTORY MODEL ERROR! WINDFIELD #### ' | |
| 571 | write(*,*) ' #### ',wfname(indj),' #### ' | |
| 572 | write(*,*) ' #### IS NOT GRIB FORMAT !!! #### ' | |
| 573 | stop 'Execution terminated' | |
| 574 | ||
| 575 | 999 write(*,*) ' #### TRAJECTORY MODEL ERROR! WINDFIELD #### ' | |
| 576 | write(*,*) ' #### ',wfname(indj),' #### ' | |
| 577 | write(*,*) ' #### CANNOT BE OPENED !!! #### ' | |
| 578 | error=1 | |
| 579 | ||
| 580 | end |
| 0 | subroutine readwind_nests(indj,n) | |
| 1 | C i i | |
| 2 | ************************************************************************ | |
| 3 | * * | |
| 4 | * This routine reads the wind fields for the nested model domains. * | |
| 5 | * It is similar to subroutine readwind, which reads the mother | |
| 6 | * domain. * | |
| 7 | * * | |
| 8 | * Authors: A. Stohl, G. Wotawa * | |
| 9 | * * | |
| 10 | * 30 December 1998 * | |
| 11 | * * | |
| 12 | * Update: * | |
| 13 | * 2011-06, implemented reading of grib2 format* | |
| 14 | * analog to FLEXPART8.22 routines * | |
| 15 | ************************************************************************ | |
| 16 | ||
| 17 | use grib_api | |
| 18 | include 'includepar' | |
| 19 | include 'includecom' | |
| 20 | ||
| 21 | integer indj,i,j,k,l,n,levdiff2,ifield,iumax,iwmax | |
| 22 | ||
| 23 | !HSO parameters for grib_api | |
| 24 | integer ifile | |
| 25 | integer iret | |
| 26 | integer igrib | |
| 27 | integer gribVer,parCat,parNum,typSurf,valSurf,discipl | |
| 28 | integer gotGrid | |
| 29 | character*24 gribErrorMsg | |
| 30 | character*20 gribFunction | |
| 31 | !HSO end | |
| 32 | ||
| 33 | * VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING | |
| 34 | ||
| 35 | C dimension of isec2 at least (22+n), where n is the number of parallels or | |
| 36 | C meridians in a quasi-regular (reduced) Gaussian or lat/long grid | |
| 37 | ||
| 38 | C dimension of zsec2 at least (10+nn), where nn is the number of vertical | |
| 39 | C coordinate parameters | |
| 40 | ||
| 41 | integer isec0(2),isec1(56),isec2(22+nxmaxn+nymaxn),isec3(2) | |
| 42 | integer isec4(64),inbuff(jpack),ilen,iswap,ierr,lunit,iword | |
| 43 | real zsec2(60+2*nuvzmax),zsec3(2),zsec4(jpunp) | |
| 44 | real xaux,yaux,xaux0,yaux0 | |
| 45 | real*8 xauxin,yauxin | |
| 46 | ||
| 47 | character*1 yoper | |
| 48 | logical error | |
| 49 | ||
| 50 | data yoper/'D'/ | |
| 51 | !HSO grib api error messages | |
| 52 | data gribErrorMsg/'Error reading grib file'/ | |
| 53 | data gribFunction/'readwind_nests'/ | |
| 54 | ||
| 55 | do 100 l=1,numbnests | |
| 56 | levdiff2=nlev_ec-nwz+1 | |
| 57 | iumax=0 | |
| 58 | iwmax=0 | |
| 59 | ||
| 60 | ifile=0 | |
| 61 | igrib=0 | |
| 62 | iret=0 | |
| 63 | * | |
| 64 | * OPENING OF DATA FILE (GRIB CODE) | |
| 65 | * | |
| 66 | 5 call grib_open_file(ifile,path(numpath+2*(l-1)+1) | |
| 67 | + (1:len(numpath+2*(l-1)+1))//trim(wfnamen(l,indj)),'r') | |
| 68 | if (iret.ne.GRIB_SUCCESS) then | |
| 69 | goto 888 ! ERROR DETECTED | |
| 70 | endif | |
| 71 | ||
| 72 | gotGrid=0 | |
| 73 | ifield=0 | |
| 74 | C loop fields | |
| 75 | 10 ifield=ifield+1 | |
| 76 | * | |
| 77 | * GET NEXT FIELDS | |
| 78 | * | |
| 79 | call grib_new_from_file(ifile,igrib,iret) | |
| 80 | if (iret.eq.GRIB_END_OF_FILE) then | |
| 81 | goto 50 ! EOF DETECTED | |
| 82 | elseif (iret.ne.GRIB_SUCCESS) then | |
| 83 | goto 888 ! ERROR DETECTED | |
| 84 | endif | |
| 85 | ||
| 86 | ! first see if we read GRIB1 or GRIB2 | |
| 87 | call grib_get_int(igrib,'editionNumber',gribVer,iret) | |
| 88 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 89 | ||
| 90 | if (gribVer.eq.1) then ! GRIB Edition 1 | |
| 91 | c print*,'GRiB Edition 1' | |
| 92 | c read the grib2 identifiers | |
| 93 | call grib_get_int(igrib,'indicatorOfParameter',isec1(6), | |
| 94 | + iret) | |
| 95 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 96 | call grib_get_int(igrib,'level',isec1(8),iret) | |
| 97 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 98 | c change code for etadot to code for omega | |
| 99 | if (isec1(6).eq.77) then | |
| 100 | isec1(6)=135 | |
| 101 | endif | |
| 102 | else | |
| 103 | c print*,'GRiB Edition 2' | |
| 104 | c read the grib2 identifiers | |
| 105 | call grib_get_int(igrib,'discipline',discipl,iret) | |
| 106 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 107 | call grib_get_int(igrib,'parameterCategory',parCat,iret) | |
| 108 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 109 | call grib_get_int(igrib,'parameterNumber',parNum,iret) | |
| 110 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 111 | call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf, | |
| 112 | + iret) | |
| 113 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 114 | call grib_get_int(igrib,'level',valSurf,iret) | |
| 115 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 116 | ! convert to grib1 identifiers | |
| 117 | isec1(6)=-1 | |
| 118 | isec1(7)=-1 | |
| 119 | isec1(8)=-1 | |
| 120 | isec1(8)=valSurf ! level | |
| 121 | if((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105))then ! T | |
| 122 | isec1(6)=130 ! indicatorOfParameter | |
| 123 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) | |
| 124 | + then ! U | |
| 125 | isec1(6)=131 ! indicatorOfParameter | |
| 126 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) | |
| 127 | + then ! V | |
| 128 | isec1(6)=132 ! indicatorOfParameter | |
| 129 | elseif((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) | |
| 130 | + then ! Q | |
| 131 | isec1(6)=133 ! indicatorOfParameter | |
| 132 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1))then !SP | |
| 133 | isec1(6)=134 ! indicatorOfParameter | |
| 134 | elseif((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot | |
| 135 | isec1(6)=135 ! indicatorOfParameter | |
| 136 | elseif((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) | |
| 137 | + then !SLP | |
| 138 | isec1(6)=151 ! indicatorOfParameter | |
| 139 | elseif((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) | |
| 140 | + then ! 10U | |
| 141 | isec1(6)=165 ! indicatorOfParameter | |
| 142 | elseif((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) | |
| 143 | + then ! 10V | |
| 144 | isec1(6)=166 ! indicatorOfParameter | |
| 145 | elseif((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) | |
| 146 | + then ! 2T | |
| 147 | isec1(6)=167 ! indicatorOfParameter | |
| 148 | elseif((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) | |
| 149 | + then ! 2D | |
| 150 | isec1(6)=168 ! indicatorOfParameter | |
| 151 | elseif((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) | |
| 152 | + then ! SD | |
| 153 | isec1(6)=141 ! indicatorOfParameter | |
| 154 | elseif((parCat.eq.6).and.(parNum.eq.1)) then ! CC | |
| 155 | isec1(6)=164 ! indicatorOfParameter | |
| 156 | elseif((parCat.eq.1).and.(parNum.eq.9)) then ! LSP | |
| 157 | isec1(6)=142 ! indicatorOfParameter | |
| 158 | elseif((parCat.eq.1).and.(parNum.eq.10)) then ! CP | |
| 159 | isec1(6)=143 ! indicatorOfParameter | |
| 160 | elseif((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) | |
| 161 | + then ! SHF | |
| 162 | isec1(6)=146 ! indicatorOfParameter | |
| 163 | elseif((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) | |
| 164 | + then ! SR | |
| 165 | isec1(6)=176 ! indicatorOfParameter | |
| 166 | elseif((parCat.eq.2).and.(parNum.eq.17)) then ! EWSS | |
| 167 | isec1(6)=180 ! indicatorOfParameter | |
| 168 | elseif((parCat.eq.2).and.(parNum.eq.18)) then ! NSSS | |
| 169 | isec1(6)=181 ! indicatorOfParameter | |
| 170 | elseif((parCat.eq.3).and.(parNum.eq.4)) then ! ORO | |
| 171 | isec1(6)=129 ! indicatorOfParameter | |
| 172 | elseif((parCat.eq.3).and.(parNum.eq.7)) then ! SDO | |
| 173 | isec1(6)=160 ! indicatorOfParameter | |
| 174 | elseif((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. | |
| 175 | + (typSurf.eq.1)) then ! LSM | |
| 176 | isec1(6)=172 ! indicatorOfParameter | |
| 177 | else | |
| 178 | print*,'***ERROR: undefined GRiB2 message found!',discipl, | |
| 179 | + parCat,parNum,typSurf | |
| 180 | endif | |
| 181 | endif ! GRIB version | |
| 182 | ||
| 183 | !HSO get the size and data of the values array | |
| 184 | if (isec1(6).ne.-1) then | |
| 185 | call grib_get_real4_array(igrib,'values',zsec4,iret) | |
| 186 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 187 | endif | |
| 188 | ||
| 189 | !HSO get the required fields from section 2 in a gribex compatible manner | |
| 190 | if(ifield.eq.1) then | |
| 191 | call grib_get_int(igrib,'numberOfPointsAlongAParallel', | |
| 192 | + isec2(2),iret) | |
| 193 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 194 | call grib_get_int(igrib,'numberOfPointsAlongAMeridian', | |
| 195 | 1 isec2(3),iret) | |
| 196 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 197 | call grib_get_int(igrib,'numberOfVerticalCoordinateValues', | |
| 198 | + isec2(12)) | |
| 199 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 200 | * CHECK GRID SPECIFICATIONS | |
| 201 | if(isec2(2).ne.nxn(l)) stop | |
| 202 | + 'READWIND: NX NOT CONSISTENT FOR A NESTING LEVEL' | |
| 203 | if(isec2(3).ne.nyn(l)) stop | |
| 204 | + 'READWIND: NY NOT CONSISTENT FOR A NESTING LEVEL' | |
| 205 | if(isec2(12)/2-1.ne.nlev_ec) stop 'READWIND: VERTICAL DISCRET | |
| 206 | +IZATION NOT CONSISTENT FOR A NESTING LEVEL' | |
| 207 | endif ! ifield | |
| 208 | !HSO get the second part of the grid dimensions only from GRiB1 messages | |
| 209 | if ((gribVer.eq.1).and.(gotGrid.eq.0)) then | |
| 210 | call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees' | |
| 211 | + ,xauxin,iret) | |
| 212 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 213 | call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', | |
| 214 | + yauxin,iret) | |
| 215 | call grib_check(iret,gribFunction,gribErrorMsg) | |
| 216 | xaux=xauxin | |
| 217 | yaux=yauxin | |
| 218 | xaux0=xlon0n(l) | |
| 219 | yaux0=ylat0n(l) | |
| 220 | if(xaux.lt.0.) xaux=xaux+360. | |
| 221 | if(yaux.lt.0.) yaux=yaux+360. | |
| 222 | if(xaux0.lt.0.) xaux0=xaux0+360. | |
| 223 | if(yaux0.lt.0.) yaux0=yaux0+360. | |
| 224 | if(xaux.ne.xaux0) | |
| 225 | + stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NES | |
| 226 | +TING LEVEL' | |
| 227 | if(yaux.ne.yaux0) | |
| 228 | + stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NEST | |
| 229 | +ING LEVEL' | |
| 230 | gotGrid=1 | |
| 231 | endif | |
| 232 | ||
| 233 | do 20 j=0,nyn(l)-1 | |
| 234 | do 20 i=0,nxn(l)-1 | |
| 235 | k=isec1(8) | |
| 236 | if(isec1(6).eq.130) ttn(i,j,nlev_ec-k+1,n,l)= !! TEMPERATURE | |
| 237 | & zsec4(nxn(l)*(nyn(l)-j-1)+i+1) | |
| 238 | if(isec1(6).eq.131) uun(i,j,nlev_ec-k+1,n,l)= !! U VELOCITY | |
| 239 | & zsec4(nxn(l)*(nyn(l)-j-1)+i+1) | |
| 240 | if(isec1(6).eq.132) vvn(i,j,nlev_ec-k+1,n,l)= !! V VELOCITY | |
| 241 | & zsec4(nxn(l)*(nyn(l)-j-1)+i+1) | |
| 242 | if(isec1(6).eq.133) then | |
| 243 | qqn(i,j,nlev_ec-k+1,n,l)= !! HUMIDITY | |
| 244 | & zsec4(nxn(l)*(nyn(l)-j-1)+i+1) | |
| 245 | if (qqn(i,j,nlev_ec-k+1,n,l).lt.0.) | |
| 246 | & qqn(i,j,nlev_ec-k+1,n,l)=0. | |
| 247 | c this is necessary because the gridded data may contain | |
| 248 | c spurious negative values | |
| 249 | endif | |
| 250 | if(isec1(6).eq.134) psn(i,j,1,n,l)= !! SURF. PRESS. | |
| 251 | & zsec4(nxn(l)*(nyn(l)-j-1)+i+1) | |
| 252 | if(isec1(6).eq.135) wwn(i,j,nlev_ec-k+1,n,l)= !! W VELOCITY | |
| 253 | & zsec4(nxn(l)*(nyn(l)-j-1)+i+1) | |
| 254 | if(isec1(6).eq.129) oron(i,j,l)= !! ECMWF OROGRAPHY | |
| 255 | & zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga | |
| 256 | if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1) | |
| 257 | if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1) | |
| 258 | 20 continue | |
| 259 | ||
| 260 | call grib_release(igrib) | |
| 261 | goto 10 !! READ NEXT LEVEL OR PARAMETER | |
| 262 | * | |
| 263 | * CLOSING OF INPUT DATA FILE | |
| 264 | * | |
| 265 | 50 call grib_close_file(ifile) | |
| 266 | * error message if no fields found with correct first longitude in it | |
| 267 | if (gotGrid.eq.0) then | |
| 268 | print*,'***ERROR: input file needs to contain GRiB1 formatted' | |
| 269 | + //'messages' | |
| 270 | stop | |
| 271 | endif | |
| 272 | ||
| 273 | if(levdiff2.eq.0) then | |
| 274 | iwmax=nlev_ec+1 | |
| 275 | do 60 j=0,nyn(l)-1 | |
| 276 | do 60 i=0,nxn(l)-1 | |
| 277 | 60 wwn(i,j,nlev_ec+1,n,l)=0. | |
| 278 | endif | |
| 279 | ||
| 280 | ||
| 281 | if(iumax.ne.nuvz) stop | |
| 282 | + 'READWIND: NUVZ NOT CONSISTENT FOR A NESTING LEVEL' | |
| 283 | if(iwmax.ne.nwz) stop | |
| 284 | + 'READWIND: NWZ NOT CONSISTENT FOR A NESTING LEVEL' | |
| 285 | ||
| 286 | ||
| 287 | ||
| 288 | C Calculate potential temperature and potential vorticity on whole grid | |
| 289 | *********************************************************************** | |
| 290 | call calcpv_nests(l,n) | |
| 291 | ||
| 292 | 100 continue ! END OF NESTS LOOP | |
| 293 | ||
| 294 | return | |
| 295 | 888 write(*,*) ' #### TRAJECTORY MODEL ERROR! WINDFIELD #### ' | |
| 296 | write(*,*) ' #### ',wfname(indj),' #### ' | |
| 297 | write(*,*) ' #### IS NOT GRIB FORMAT !!! #### ' | |
| 298 | stop 'Execution terminated' | |
| 299 | ||
| 300 | ||
| 301 | 999 write(*,*) | |
| 302 | write(*,*) ' ###########################################'// | |
| 303 | & '###### ' | |
| 304 | write(*,*) ' TRAJECTORY MODEL SUBROUTINE GRIDCHECK:' | |
| 305 | write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfnamen(l,indj) | |
| 306 | write(*,*) ' FOR NESTING LEVEL ',l | |
| 307 | write(*,*) ' ###########################################'// | |
| 308 | & '###### ' | |
| 309 | error=.true. | |
| 310 | ||
| 311 | end |
| 0 | subroutine readwind_nests(indj,n) | |
| 1 | C i i | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine reads the wind fields for the nested model domains. * | |
| 5 | * It is similar to subroutine readwind, which reads the mother domain. * | |
| 6 | * * | |
| 7 | * Authors: A. Stohl, G. Wotawa * | |
| 8 | * * | |
| 9 | * 30 December 1998 * | |
| 10 | ******************************************************************************** | |
| 11 | ||
| 12 | ||
| 13 | include 'includepar' | |
| 14 | include 'includecom' | |
| 15 | ||
| 16 | integer indj, n | |
| 17 | ||
| 18 | IF(NUMBNESTS.NE.0) | |
| 19 | & STOP 'SORRY: FLEXTRA (NCEP) CAN NOT BE OPERATED WITH NESTING' | |
| 20 | ||
| 21 | end |
| 0 | subroutine skplin(nlines,iunit) | |
| 1 | C i i | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine reads nlines from unit iunit and discards them | |
| 5 | * * | |
| 6 | * Authors: Petra Seibert | |
| 7 | * * | |
| 8 | * 31 Dec 1998 | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: | |
| 13 | * | |
| 14 | * iunit unit number from which lines are to be skipped | |
| 15 | * nlines number of lines to be skipped | |
| 16 | * | |
| 17 | ********************************************************************************* | |
| 18 | ||
| 19 | integer i,iunit, nlines | |
| 20 | ||
| 21 | do 10 i=1,nlines | |
| 22 | 10 read(iunit,*) | |
| 23 | ||
| 24 | return | |
| 25 | end |
| 0 | subroutine subtractoro() | |
| 1 | ******************************************************************************** | |
| 2 | * * | |
| 3 | * This routine subtracts the height of the orography from the height above * | |
| 4 | * sea level to give height above the model ground. * | |
| 5 | * * | |
| 6 | * Author: A. Stohl * | |
| 7 | * * | |
| 8 | * 30 April 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * dist distance of starting point to grid points * | |
| 14 | * maxnests maximum number of nesting levels * | |
| 15 | * ngrid nesting level to be used * | |
| 16 | * numpoint actual number of starting points * | |
| 17 | * oro(0:nxmax-1,0:nymax-1) orography (mother domain) * | |
| 18 | * oron(0:nxmaxn-1,0:nymaxn-1,maxnests) orography (nested grids) * | |
| 19 | * orohelp interpolated orography * | |
| 20 | * sweight weight for linear interpolation * | |
| 21 | * xpoint,ypoint,zpoint(maxpoint) x,y,z coordinates of starting points * | |
| 22 | * * | |
| 23 | * Constants: * | |
| 24 | * maxpoint maximum number of starting points * | |
| 25 | * * | |
| 26 | ******************************************************************************** | |
| 27 | ||
| 28 | include 'includepar' | |
| 29 | include 'includecom' | |
| 30 | ||
| 31 | integer j,k,ngrid | |
| 32 | real orohelp,xtn,ytn | |
| 33 | ||
| 34 | ||
| 35 | do 10 k=1,numpoint ! loop over all starting points | |
| 36 | ||
| 37 | C Only subtract for those trajectories with z coordinates given in masl | |
| 38 | *********************************************************************** | |
| 39 | ||
| 40 | if (kindz(k).eq.1) then | |
| 41 | ||
| 42 | C Determine which nesting level to be used | |
| 43 | ****************************************** | |
| 44 | ||
| 45 | ngrid=0 | |
| 46 | do 12 j=numbnests,1,-1 | |
| 47 | if ((xpoint(k).gt.xln(j)).and.(xpoint(k).lt.xrn(j)).and. | |
| 48 | + (ypoint(k).gt.yln(j)).and.(ypoint(k).lt.yrn(j))) then | |
| 49 | ngrid=j | |
| 50 | goto 13 | |
| 51 | endif | |
| 52 | 12 continue | |
| 53 | 13 continue | |
| 54 | ||
| 55 | ||
| 56 | C Interpolate orography to position of starting point | |
| 57 | ***************************************************** | |
| 58 | ||
| 59 | if (ngrid.eq.0) then | |
| 60 | call orolininterpol(oro,nxmax,nymax,nx,ny,xpoint(k), | |
| 61 | + ypoint(k),orohelp) | |
| 62 | else | |
| 63 | xtn=(xpoint(k)-xln(ngrid))*xresoln(ngrid) | |
| 64 | ytn=(ypoint(k)-yln(ngrid))*yresoln(ngrid) | |
| 65 | call orolininterpoln(oron,maxnests,nxmaxn,nymaxn,ngrid, | |
| 66 | + nxn,nyn,xtn,ytn,orohelp) | |
| 67 | endif | |
| 68 | ||
| 69 | ||
| 70 | C Subtract orography from height, but don't accept negative heights | |
| 71 | ******************************************************************* | |
| 72 | ||
| 73 | zpoint(k)=zpoint(k)-orohelp | |
| 74 | zpoint(k)=max(0.,zpoint(k)) | |
| 75 | endif | |
| 76 | 10 continue | |
| 77 | ||
| 78 | return | |
| 79 | end |
| 0 | subroutine timemanager() | |
| 1 | ||
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * Handles the computation of trajectories, i.e. determines which * | |
| 5 | * trajectories have to be computed at what time. * | |
| 6 | * * | |
| 7 | * Pointers (field numb(maxtra) are used to keep track of the trajectories. * | |
| 8 | * The pointers are kept sorted in the order of the next necessary time step, * | |
| 9 | * i.e., numb(1) points to the first trajectory that needs a time step. * | |
| 10 | * After doing the time step, the pointers are resorted, e.g., numb(2) * | |
| 11 | * changes to numb(1), numb(3) to numb(2), etc. Numb(1) is inserted between * | |
| 12 | * those two pointers, which need a time step before and after numb(1). * | |
| 13 | * * | |
| 14 | * * | |
| 15 | * Author: A. Stohl * | |
| 16 | * * | |
| 17 | * 6 February 1994 * | |
| 18 | * * | |
| 19 | ******************************************************************************** | |
| 20 | * * | |
| 21 | * Variables: * | |
| 22 | * ideltas [s] modelling period * | |
| 23 | * init .true. for first time step of trajectory, false .else. * | |
| 24 | * interv [s] interval between two trajectory starting times * | |
| 25 | * itime [s] actual temporal position of calculation * | |
| 26 | * ittra(maxtra,maxtime) temporal positions of trajectories * | |
| 27 | * kind(maxtra) type of trajectory (e.g. isobaric, 3-d, model layers,..) * | |
| 28 | * kindz(maxtra) unit of height coordinate (1:masl, 2:magl, 3:hPa) * | |
| 29 | * ldirect Temporal direction of trajectories (-1=backward,1=forward)* | |
| 30 | * lentra temporal length of one trajectory * | |
| 31 | * levmem(maxtra) [K] height of isentropic trajectories * | |
| 32 | * minstep minimum time step (to prevent exceedance of dimensions) * | |
| 33 | * nextflight [s] next time, initialization of FLIGHT trajectories is due * | |
| 34 | * npoint(maxtra) index, which starting point the trajectory has * | |
| 35 | * nstop = greater than 0 when trajectory calculation is finished * | |
| 36 | * ntstep [s] time step of integration scheme * | |
| 37 | * nttra(maxtra) number of time steps which are already computed * | |
| 38 | * numb(maxtra) pointer, which allows the identification of trajectories * | |
| 39 | * number help variable * | |
| 40 | * numtra actual number of trajectories in memory * | |
| 41 | * xpoint(maxpoint), ypoint(maxpoint),zpoint(maxpoint) = * | |
| 42 | * xpoint(maxpoint), ypoint(maxpoint),zpoint(maxpoint) = * | |
| 43 | * starting positions of trajectories * | |
| 44 | * xtra(maxtra,maxtime), ytra(maxtra,maxtime), ztra(maxtra,maxtime) = * | |
| 45 | * spatial positions of trajectories * | |
| 46 | * * | |
| 47 | * Constants: * | |
| 48 | * maxtra maximum number of trajectories * | |
| 49 | * maxtime maximum number of time steps * | |
| 50 | * * | |
| 51 | ******************************************************************************** | |
| 52 | ||
| 53 | include 'includepar' | |
| 54 | include 'includecom' | |
| 55 | ||
| 56 | integer i,j,itime,ntstep,nstop(maxtra),lhelp,minstep,numb(maxtra) | |
| 57 | integer number,idummy,ldat,ltim,ninterv1,ninterv2,ninterv3 | |
| 58 | real levmem(maxtra),gasdev | |
| 59 | logical init,unc,error | |
| 60 | double precision juldate | |
| 61 | save idummy | |
| 62 | ||
| 63 | data idummy/-7/ | |
| 64 | ||
| 65 | ||
| 66 | do 5 i=1,maxtra | |
| 67 | 5 nttra(i)=0 | |
| 68 | numtra=0 ! first: no trajectories | |
| 69 | ||
| 70 | ||
| 71 | C Loop over the whole modelling period in time steps of seconds | |
| 72 | *************************************************************** | |
| 73 | ||
| 74 | do 10 itime=0,ideltas,ldirect | |
| 75 | if (mod(itime,3600).eq.0) write(*,*) itime,' SECONDS SIMULATED' | |
| 76 | ||
| 77 | ||
| 78 | C Check whether some trajectories have already finished. If so, call output | |
| 79 | C and make memory available for new trajectory. | |
| 80 | *************************************************************************** | |
| 81 | ||
| 82 | if (numtra.gt.0) then | |
| 83 | ||
| 84 | i=1 | |
| 85 | 33 continue | |
| 86 | number=numb(i) | |
| 87 | ||
| 88 | if (abs(ittra(number,nttra(number))).gt.abs(itime)) goto 37 | |
| 89 | if ((nstop(number).gt.0).and. ! trajectory terminated | |
| 90 | + (ittra(number,nttra(number)).eq.itime)) then ! output time | |
| 91 | c if (modecet.ne.2) then ! don't make output for CETs | |
| 92 | call trajout(number,nstop(number)) ! output of trajectory | |
| 93 | nttra(number)=0 ! reinitialize | |
| 94 | do 35 j=i,numtra-1 ! resort the pointers | |
| 95 | 35 numb(j)=numb(j+1) | |
| 96 | c endif | |
| 97 | numtra=numtra-1 ! forget one trajectory | |
| 98 | i=i-1 | |
| 99 | endif | |
| 100 | if (i.lt.numtra) then | |
| 101 | i=i+1 | |
| 102 | goto 33 | |
| 103 | else | |
| 104 | goto 37 | |
| 105 | endif | |
| 106 | ||
| 107 | 37 continue | |
| 108 | endif | |
| 109 | ||
| 110 | ||
| 111 | ||
| 112 | C Check whether new trajectories have to be started | |
| 113 | C 1nd if: check if time within modeling period | |
| 114 | C 2nd if: check if the interval interv has passed by (for NORMAL | |
| 115 | C trajectories) or if a FLIGHT traj. is due to be started | |
| 116 | ***************************************************************** | |
| 117 | ||
| 118 | if (abs(itime).le.abs(ideltas-lentra)) then | |
| 119 | if (modecet.eq.3) then ! FLIGHT mode | |
| 120 | 41 continue | |
| 121 | if ((nextflight.eq.itime).and.(numtra.lt.maxtra)) then | |
| 122 | do 43 i=numtra,1,-1 ! shift pointers | |
| 123 | 43 numb(i+1)=numb(i) | |
| 124 | numtra=numtra+1 ! increase number of traj. | |
| 125 | ||
| 126 | j=1 ! initialize FLIGHT traj. | |
| 127 | 42 continue | |
| 128 | if (nttra(j).eq.0) then | |
| 129 | numb(1)=j | |
| 130 | npoint(j)=1 | |
| 131 | levmem(j)=zpoint(1) | |
| 132 | xtra(j,1)=xpoint(1) | |
| 133 | ytra(j,1)=ypoint(1) | |
| 134 | ztra(j,1)=zpoint(1) | |
| 135 | ittra(j,1)=itime | |
| 136 | nttra(j)=1 | |
| 137 | kind(j)=kind(1) | |
| 138 | kindz(j)=kindz(1) | |
| 139 | else | |
| 140 | j=j+1 | |
| 141 | if (j.gt.maxtra) stop 'timemanager: too many trajectorie | |
| 142 | +s. Increase parameter maxtra and re-start' | |
| 143 | goto 42 | |
| 144 | endif | |
| 145 | ||
| 146 | C Read the next FLIGHT traj. | |
| 147 | **************************** | |
| 148 | ||
| 149 | read(unitpoin,*,err=15,end=15) ldat,ltim | |
| 150 | read(unitpoin,*,err=15,end=15) xpoint(1) | |
| 151 | read(unitpoin,*,err=15,end=15) ypoint(1) | |
| 152 | read(unitpoin,*,err=15,end=15) zpoint(1) | |
| 153 | read(unitpoin,*,err=15,end=15) | |
| 154 | nextflight=nint(sngl(juldate(ldat,ltim)-bdate)*86400.) | |
| 155 | call coordtrafo(error) | |
| 156 | if (error) stop | |
| 157 | call subtractoro() | |
| 158 | if (kindz(1).eq.3) zpoint(1)=zpoint(1)*100. | |
| 159 | ||
| 160 | goto 41 | |
| 161 | endif | |
| 162 | ||
| 163 | else if (mod(itime,interv).eq.0) then !non-FLIGHT mode, initialization due | |
| 164 | do 40 i=numtra,1,-1 ! shift pointers | |
| 165 | 40 numb(i+numpoint)=numb(i) | |
| 166 | numtra=numtra+numpoint ! increase number of traj. | |
| 167 | ||
| 168 | ||
| 169 | C Initialize new trajectories | |
| 170 | ***************************** | |
| 171 | ||
| 172 | j=1 | |
| 173 | do 50 i=1,numpoint ! search for available memory | |
| 174 | 55 continue | |
| 175 | if (nttra(j).eq.0) then | |
| 176 | numb(i)=j | |
| 177 | npoint(j)=i | |
| 178 | levmem(j)=zpoint(i) | |
| 179 | xtra(j,1)=xpoint(i) | |
| 180 | ytra(j,1)=ypoint(i) | |
| 181 | ztra(j,1)=zpoint(i) | |
| 182 | ittra(j,1)=itime | |
| 183 | nttra(j)=1 | |
| 184 | kind(j)=kind(i) | |
| 185 | kindz(j)=kindz(i) | |
| 186 | randerroru(j)=gasdev(idummy)*epsu | |
| 187 | randerrorv(j)=gasdev(idummy)*epsv | |
| 188 | randerrorw(j)=gasdev(idummy)*epsw | |
| 189 | else | |
| 190 | j=j+1 | |
| 191 | goto 55 | |
| 192 | endif | |
| 193 | 50 continue | |
| 194 | ||
| 195 | endif | |
| 196 | endif | |
| 197 | ||
| 198 | ||
| 199 | ||
| 200 | C Check whether a time step of the first trajectory is necessary | |
| 201 | **************************************************************** | |
| 202 | ||
| 203 | 15 continue | |
| 204 | if (numtra.gt.0) then | |
| 205 | ||
| 206 | number=numb(1) | |
| 207 | ||
| 208 | if (ittra(number,nttra(number)).eq.itime) then | |
| 209 | ||
| 210 | C minstep is the minimum possible time step. It is necessary to | |
| 211 | C guarantee that the sum of all time steps along the trajectory | |
| 212 | C is smaller than maxtime (otherwise exceedance of dimensions). | |
| 213 | *************************************************************** | |
| 214 | ||
| 215 | lhelp=itime-ittra(number,1) ! "age" of trajectory | |
| 216 | minstep=abs(lentra-lhelp)/(maxtime-nttra(number))+1 | |
| 217 | ||
| 218 | ||
| 219 | C Mark first time step of trajectory with variable init=.TRUE. | |
| 220 | ************************************************************** | |
| 221 | ||
| 222 | if (nttra(number).eq.1) then | |
| 223 | init=.true. | |
| 224 | else | |
| 225 | init=.false. | |
| 226 | endif | |
| 227 | ||
| 228 | ||
| 229 | C Determine whether current trajectory is an uncertainty trajectory | |
| 230 | ******************************************************************* | |
| 231 | ||
| 232 | if (compoint(npoint(number))(41:41).eq.'U') then | |
| 233 | unc=.TRUE. | |
| 234 | else | |
| 235 | unc=.FALSE. | |
| 236 | endif | |
| 237 | ||
| 238 | ||
| 239 | C Calculate the next step of the trajectory | |
| 240 | ******************************************* | |
| 241 | ||
| 242 | call petters(minstep,lhelp,itime,xtra(number,nttra(number)), | |
| 243 | + ytra(number,nttra(number)),ztra(number,nttra(number)), | |
| 244 | + ptra(number,nttra(number)),htra(number,nttra(number)), | |
| 245 | + qqtra(number,nttra(number)),pvtra(number,nttra(number)), | |
| 246 | + thtra(number,nttra(number)), | |
| 247 | + xtra(number,nttra(number)+1),ytra(number,nttra(number)+1), | |
| 248 | + ztra(number,nttra(number)+1),ptra(number,nttra(number)+1), | |
| 249 | + htra(number,nttra(number)+1),qqtra(number,nttra(number)+1), | |
| 250 | + pvtra(number,nttra(number)+1),thtra(number,nttra(number)+1), | |
| 251 | + ntstep,nstop(number), | |
| 252 | + levmem(number),init,kind(number),kindz(number),unc, | |
| 253 | + randerroru(number),randerrorv(number),randerrorw(number)) | |
| 254 | ||
| 255 | ittra(number,nttra(number)+1)=ittra(number,nttra(number))+ | |
| 256 | + ntstep | |
| 257 | ||
| 258 | nttra(number)=nttra(number)+1 ! one more time step | |
| 259 | ||
| 260 | ||
| 261 | C If output is only due with constant time steps, disregard all points | |
| 262 | C not needed for interpolation: delete previous time step | |
| 263 | ********************************************************************** | |
| 264 | ||
| 265 | if ((inter.eq.1).and.(nttra(number).ge.3)) then | |
| 266 | ninterv1=abs(ittra(number,nttra(number))-ittra(number,1))/ | |
| 267 | + interstep | |
| 268 | ninterv2=abs(ittra(number,nttra(number)-1)-ittra(number,1))/ | |
| 269 | + interstep | |
| 270 | ninterv3=abs(ittra(number,nttra(number)-2)-ittra(number,1))/ | |
| 271 | + interstep | |
| 272 | if ((ninterv1.eq.ninterv2).and.(ninterv1.eq.ninterv3)) then | |
| 273 | ittra(number,nttra(number)-1)=ittra(number,nttra(number)) | |
| 274 | xtra(number,nttra(number)-1)=xtra(number,nttra(number)) | |
| 275 | ytra(number,nttra(number)-1)=ytra(number,nttra(number)) | |
| 276 | ztra(number,nttra(number)-1)=ztra(number,nttra(number)) | |
| 277 | ptra(number,nttra(number)-1)=ptra(number,nttra(number)) | |
| 278 | htra(number,nttra(number)-1)=htra(number,nttra(number)) | |
| 279 | qqtra(number,nttra(number)-1)=qqtra(number,nttra(number)) | |
| 280 | pvtra(number,nttra(number)-1)=pvtra(number,nttra(number)) | |
| 281 | thtra(number,nttra(number)-1)=thtra(number,nttra(number)) | |
| 282 | nttra(number)=nttra(number)-1 | |
| 283 | endif | |
| 284 | endif | |
| 285 | ||
| 286 | C If field dimension is reached, trajectory has to be terminated | |
| 287 | **************************************************************** | |
| 288 | ||
| 289 | if (nttra(number).eq.maxtime) nstop(number)=5 | |
| 290 | ||
| 291 | ||
| 292 | C If trajectory has ended, give the next time step the time of normal | |
| 293 | C length of trajectory and wait for output of trajectory | |
| 294 | ********************************************************************* | |
| 295 | ||
| 296 | if (nstop(number).gt.0) then | |
| 297 | ittra(number,nttra(number))=ittra(number,1)+lentra | |
| 298 | endif | |
| 299 | ||
| 300 | ||
| 301 | C Shift the trajectories in a way that the current trajectory can be | |
| 302 | C inserted at the right position. | |
| 303 | C The position is determined by the time, when the next integration step | |
| 304 | C is necessary. | |
| 305 | ************************************************************************* | |
| 306 | ||
| 307 | do 20 i=1,numtra-1 | |
| 308 | if (abs(ittra(numb(i+1),nttra(numb(i+1)))).lt. | |
| 309 | + abs(ittra(number,nttra(number)))) then | |
| 310 | numb(i)=numb(i+1) | |
| 311 | else | |
| 312 | numb(i)=number ! insert the pointer | |
| 313 | goto 15 ! leave loop | |
| 314 | endif | |
| 315 | 20 continue | |
| 316 | ||
| 317 | C The next statement can only be reached, when the current trajectory is the | |
| 318 | C last one that needs an integration step. | |
| 319 | **************************************************************************** | |
| 320 | ||
| 321 | numb(numtra)=number | |
| 322 | goto 15 ! check next trajectory | |
| 323 | endif | |
| 324 | endif | |
| 325 | ||
| 326 | ||
| 327 | 10 continue | |
| 328 | ||
| 329 | return | |
| 330 | end |
| 0 | subroutine trajinterpol(numb,ldimi,orotra,orotraint) | |
| 1 | C i o | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine interpolates the trajectories to a constant time step. * | |
| 5 | * * | |
| 6 | * Author: A. Stohl * | |
| 7 | * * | |
| 8 | * 11 February 1994 * | |
| 9 | * * | |
| 10 | * 27 February 1999 Correction by Wuyin Lin to the cyclic * | |
| 11 | * boundary conditions * | |
| 12 | * * | |
| 13 | ******************************************************************************** | |
| 14 | * * | |
| 15 | * Variables: * | |
| 16 | * numb number of trajectory to be interpolated * | |
| 17 | * * | |
| 18 | * * | |
| 19 | * Constants: * | |
| 20 | * * | |
| 21 | ******************************************************************************** | |
| 22 | ||
| 23 | include 'includepar' | |
| 24 | include 'includecom' | |
| 25 | ||
| 26 | integer numb,i,j,k,ldimi | |
| 27 | real orotra(maxtime),orotraint(maxitime),xtmp1,xtmp2 | |
| 28 | ||
| 29 | ldimi=1 | |
| 30 | do 10 i=1,ldim | |
| 31 | 10 ittraint(i)=ittra(numb,1)+(i-1)*ldirect*interstep | |
| 32 | ||
| 33 | xtraint(1)=xtra(numb,1) | |
| 34 | ytraint(1)=ytra(numb,1) | |
| 35 | ztraint(1)=ztra(numb,1) | |
| 36 | ptraint(1)=ptra(numb,1) | |
| 37 | htraint(1)=htra(numb,1) | |
| 38 | qqtraint(1)=qqtra(numb,1) | |
| 39 | pvtraint(1)=pvtra(numb,1) | |
| 40 | thtraint(1)=thtra(numb,1) | |
| 41 | orotraint(1)=orotra(1) | |
| 42 | ||
| 43 | k=2 | |
| 44 | do 20 i=2,ldim | |
| 45 | do 30 j=k,nttra(numb) | |
| 46 | if (abs(ittra(numb,j)).ge.abs(ittraint(i)))then | |
| 47 | ||
| 48 | C Linear interpolation | |
| 49 | C For x coordinate, special treatment when using cyclic boundary | |
| 50 | C conditions to keep values below 360 deg | |
| 51 | **************************************************************** | |
| 52 | ||
| 53 | ldimi=i | |
| 54 | xtmp1=xtra(numb,j-1) | |
| 55 | xtmp2=xtra(numb,j) | |
| 56 | if (xglobal) then | |
| 57 | if (abs(xtra(numb,j-1)-xtra(numb,j)).gt.180.) then | |
| 58 | if (xtra(numb,j-1).lt.xtra(numb,j)) then | |
| 59 | xtmp1=xtra(numb,j-1)+360. | |
| 60 | else | |
| 61 | xtmp2=xtra(numb,j)+360. | |
| 62 | endif | |
| 63 | endif | |
| 64 | endif | |
| 65 | ||
| 66 | xtraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 67 | + xtmp1+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 68 | + xtmp2)/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 69 | ||
| 70 | if (xtraint(i).gt.360.) xtraint(i)=xtraint(i)-360. | |
| 71 | ||
| 72 | ||
| 73 | ytraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 74 | + ytra(numb,j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 75 | + ytra(numb,j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 76 | ||
| 77 | ztraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 78 | + ztra(numb,j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 79 | + ztra(numb,j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 80 | ||
| 81 | ptraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 82 | + ptra(numb,j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 83 | + ptra(numb,j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 84 | ||
| 85 | htraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 86 | + htra(numb,j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 87 | + htra(numb,j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 88 | ||
| 89 | qqtraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 90 | + qqtra(numb,j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 91 | + qqtra(numb,j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 92 | ||
| 93 | pvtraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 94 | + pvtra(numb,j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 95 | + pvtra(numb,j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 96 | ||
| 97 | thtraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 98 | + thtra(numb,j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 99 | + thtra(numb,j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 100 | ||
| 101 | orotraint(i)=(float(abs(ittra(numb,j)-ittraint(i)))* | |
| 102 | + orotra(j-1)+float(abs(ittra(numb,j-1)-ittraint(i)))* | |
| 103 | + orotra(j))/float(abs(ittra(numb,j)-ittra(numb,j-1))) | |
| 104 | ||
| 105 | k=j | |
| 106 | ||
| 107 | goto 20 | |
| 108 | endif | |
| 109 | 30 continue | |
| 110 | ||
| 111 | 20 continue | |
| 112 | ||
| 113 | return | |
| 114 | end |
| 0 | subroutine trajout(numb,nstop) | |
| 1 | C i i | |
| 2 | ******************************************************************************** | |
| 3 | * * | |
| 4 | * This routine writes the output files. * | |
| 5 | * * | |
| 6 | * Authors: A. Stohl * | |
| 7 | * * | |
| 8 | * 2 February 1994 * | |
| 9 | * * | |
| 10 | ******************************************************************************** | |
| 11 | * * | |
| 12 | * Variables: * | |
| 13 | * bdate beginning date of modelling period * | |
| 14 | * * | |
| 15 | * idate,itime date and time,help variables * | |
| 16 | * inter output with flexible (0,2) or constant time step (1,2) * | |
| 17 | * ldim number of interpolated time steps * | |
| 18 | * maxnests maximum number of nesting levels * | |
| 19 | * ngrid nesting level to be used * | |
| 20 | * npoint(maxtra) number of starting point for each trajectory * | |
| 21 | * nstop error code * | |
| 22 | * nttra(maxtra) number of time steps along the trajectory * | |
| 23 | * numb number of trajectory to be written to output file * | |
| 24 | * juldat Julian starting date of trajectory * | |
| 25 | * xtra,ytra,ztra(maxtra,maxtime) grid coordinates of trajectory (flexible) * | |
| 26 | * xtraint,ytraint,ztraint(maxitime) grid coordinates of trajectory (flexible) * | |
| 27 | * * | |
| 28 | * Constants: * | |
| 29 | * * | |
| 30 | ******************************************************************************** | |
| 31 | ||
| 32 | include 'includepar' | |
| 33 | include 'includecom' | |
| 34 | ||
| 35 | integer nstop,numb,idate,itime,i,j,ldimi,ngrid | |
| 36 | real orotra(maxtime),orotraint(maxitime),xtn,ytn | |
| 37 | double precision juldat | |
| 38 | ||
| 39 | ||
| 40 | C If serious error has occurred, reduce the number of time steps by 1. | |
| 41 | C This has to be done to exclude unrealistic values. | |
| 42 | ********************************************************************** | |
| 43 | ||
| 44 | if (nstop.gt.1) nttra(numb)=nttra(numb)-1 | |
| 45 | ||
| 46 | ||
| 47 | C Add the height of the orography to give height above sea level | |
| 48 | **************************************************************** | |
| 49 | ||
| 50 | do 10 i=1,nttra(numb) | |
| 51 | ||
| 52 | C Determine which nesting level to be used | |
| 53 | ****************************************** | |
| 54 | ||
| 55 | ngrid=0 | |
| 56 | do 12 j=numbnests,1,-1 | |
| 57 | if ((xtra(numb,i).gt.xln(j)).and.(xtra(numb,i).lt.xrn(j)).and. | |
| 58 | + (ytra(numb,i).gt.yln(j)).and.(ytra(numb,i).lt.yrn(j))) then | |
| 59 | ngrid=j | |
| 60 | goto 13 | |
| 61 | endif | |
| 62 | 12 continue | |
| 63 | 13 continue | |
| 64 | ||
| 65 | if (ngrid.eq.0) then | |
| 66 | call orolininterpol(oro,nxmax,nymax,nx,ny,xtra(numb,i), | |
| 67 | + ytra(numb,i),orotra(i)) | |
| 68 | else | |
| 69 | xtn=(xtra(numb,i)-xln(ngrid))*xresoln(ngrid) | |
| 70 | ytn=(ytra(numb,i)-yln(ngrid))*yresoln(ngrid) | |
| 71 | call orolininterpoln(oron,maxnests,nxmaxn,nymaxn,ngrid, | |
| 72 | + nxn,nyn,xtn,ytn,orotra(i)) | |
| 73 | endif | |
| 74 | 10 htra(numb,i)=htra(numb,i)+orotra(i) | |
| 75 | ||
| 76 | ||
| 77 | C Conversion of grid coordinates to geografical coordinates | |
| 78 | *********************************************************** | |
| 79 | ||
| 80 | do 30 i=1,nttra(numb) | |
| 81 | call lamphi_ecmwf(xtra(numb,i),ytra(numb,i),xtra(numb,i), | |
| 82 | + ytra(numb,i)) | |
| 83 | 30 ptra(numb,i)=ptra(numb,i)/100. ! conversion Pa -> hPa | |
| 84 | ||
| 85 | ||
| 86 | C If trajectory information is wanted with constant time step, interpolate the | |
| 87 | C trajectory to constant time step | |
| 88 | ****************************************************************************** | |
| 89 | ||
| 90 | if (inter.ge.1) then | |
| 91 | call trajinterpol(numb,ldimi,orotra,orotraint) | |
| 92 | endif | |
| 93 | ||
| 94 | ||
| 95 | C Calculate starting date and time of trajectory | |
| 96 | ************************************************ | |
| 97 | ||
| 98 | juldat=bdate+dble(float(ittra(numb,1)))/86400. | |
| 99 | call caldate(juldat,idate,itime) | |
| 100 | ||
| 101 | ||
| 102 | C Output of normal (non-CET) trajectories | |
| 103 | ***************************************** | |
| 104 | ||
| 105 | if (modecet.eq.1) then | |
| 106 | ||
| 107 | ||
| 108 | C Output of trajectories with flexible time step | |
| 109 | ************************************************ | |
| 110 | ||
| 111 | if ((inter.eq.0).or.(inter.eq.2)) then | |
| 112 | if (nttra(numb).eq.1) nttra(numb)=0 | |
| 113 | write(unittraj+npoint(numb),'(a6,i8,a9,i8,a16,i1,a16,i5)') | |
| 114 | + 'DATE: ',idate,' TIME:',itime,' STOP INDEX: ',nstop, | |
| 115 | + ' # OF POINTS:',nttra(numb) | |
| 116 | write(unittraj+npoint(numb),67) ' SECS', | |
| 117 | + ' LONGIT',' LATIT',' ETA',' PRESS',' Z',' Z-ORO', | |
| 118 | +' PV',' THETA',' Q' | |
| 119 | do 40 i=1,nttra(numb) | |
| 120 | 40 write(unittraj+npoint(numb),66) | |
| 121 | + ittra(numb,i)-ittra(numb,1),xtra(numb,i),ytra(numb,i), | |
| 122 | + ztra(numb,i)*zdirect,ptra(numb,i),htra(numb,i), | |
| 123 | + htra(numb,i)-orotra(i),pvtra(numb,i),thtra(numb,i), | |
| 124 | + qqtra(numb,i) | |
| 125 | endif | |
| 126 | ||
| 127 | ||
| 128 | C Output of trajectories with constant time step | |
| 129 | ************************************************ | |
| 130 | ||
| 131 | if (inter.ge.1) then | |
| 132 | if (ldimi.eq.1) ldimi=0 | |
| 133 | write(unittraji+npoint(numb),'(a6,i8,a9,i8,a16,i1,a16,i5)') | |
| 134 | + 'DATE: ',idate,' TIME:',itime,' STOP INDEX: ',nstop, | |
| 135 | + ' # OF POINTS:',ldimi | |
| 136 | write(unittraji+npoint(numb),67) ' SECS', | |
| 137 | + ' LONGIT',' LATIT',' ETA',' PRESS',' Z',' Z-ORO', | |
| 138 | +' PV',' THETA',' Q' | |
| 139 | do 50 i=1,ldimi | |
| 140 | 50 write(unittraji+npoint(numb),66) | |
| 141 | + ittraint(i)-ittraint(1),xtraint(i),ytraint(i),ztraint(i)* | |
| 142 | + zdirect,ptraint(i),htraint(i),htraint(i)-orotraint(i), | |
| 143 | + pvtraint(i),thtraint(i),qqtraint(i) | |
| 144 | endif | |
| 145 | ||
| 146 | C Output of CET or FLIGHT trajectories | |
| 147 | ************************************** | |
| 148 | ||
| 149 | else | |
| 150 | ||
| 151 | C Output of trajectories with flexible time step | |
| 152 | ************************************************ | |
| 153 | ||
| 154 | if ((inter.eq.0).or.(inter.eq.2)) then | |
| 155 | if (nttra(numb).eq.1) nttra(numb)=0 | |
| 156 | write(unittraj,'(a6,i8,a9,i8,a16,i1,a16,i5)') | |
| 157 | + 'DATE: ',idate,' TIME:',itime,' STOP INDEX: ',nstop, | |
| 158 | + ' # OF POINTS:',nttra(numb) | |
| 159 | write(unittraj,67) ' SECS', | |
| 160 | + ' LONGIT',' LATIT',' ETA',' PRESS',' Z',' Z-ORO', | |
| 161 | +' PV',' THETA',' Q' | |
| 162 | do 140 i=1,nttra(numb) | |
| 163 | 140 write(unittraj,66) | |
| 164 | + ittra(numb,i)-ittra(numb,1),xtra(numb,i),ytra(numb,i), | |
| 165 | + ztra(numb,i)*zdirect,ptra(numb,i),htra(numb,i), | |
| 166 | + htra(numb,i)-orotra(i),pvtra(numb,i),thtra(numb,i), | |
| 167 | + qqtra(numb,i) | |
| 168 | endif | |
| 169 | ||
| 170 | ||
| 171 | C Output of trajectories with constant time step | |
| 172 | ************************************************ | |
| 173 | ||
| 174 | if (inter.ge.1) then | |
| 175 | if (ldimi.eq.1) ldimi=0 | |
| 176 | write(unittraji,'(a6,i8,a9,i8,a16,i1,a16,i5)') | |
| 177 | + 'DATE: ',idate,' TIME:',itime,' STOP INDEX: ',nstop, | |
| 178 | + ' # OF POINTS:',ldimi | |
| 179 | write(unittraji,67) ' SECS', | |
| 180 | + ' LONGIT',' LATIT',' ETA',' PRESS',' Z',' Z-ORO', | |
| 181 | +' PV',' THETA',' Q' | |
| 182 | do 150 i=1,ldimi | |
| 183 | 150 write(unittraji,66) | |
| 184 | + ittraint(i)-ittraint(1),xtraint(i),ytraint(i),ztraint(i)* | |
| 185 | + zdirect,ptraint(i),htraint(i),htraint(i)-orotraint(i), | |
| 186 | + pvtraint(i),thtraint(i),qqtraint(i) | |
| 187 | endif | |
| 188 | ||
| 189 | endif | |
| 190 | ||
| 191 | 66 format(i9,2f9.4,f7.4,f7.1,2f8.1,f8.3,f6.1,e9.2) | |
| 192 | 67 format(a9,a9,a9,a7,a7,a8,a8,a8,a6,a9) | |
| 193 | ||
| 194 | return | |
| 195 | end |
| 0 | subroutine uncertcoor() | |
| 1 | ******************************************************************************** | |
| 2 | * * | |
| 3 | * This routine calculates the starting positions of the uncertainty traject. * | |
| 4 | * * | |
| 5 | * Authors: A. Stohl * | |
| 6 | * * | |
| 7 | * 16 February 1994 * | |
| 8 | * * | |
| 9 | ******************************************************************************** | |
| 10 | * * | |
| 11 | * Variables: * | |
| 12 | * compoint(maxpoint) comment for each starting point * | |
| 13 | * numbunc number of uncertainty trajectories * | |
| 14 | * numpoint actual number of starting points * | |
| 15 | * phi angle, help variable * | |
| 16 | * xpoint,ypoint,zpoint(maxpoint) x,y,z coordinates of starting points * | |
| 17 | * * | |
| 18 | * Constants: * | |
| 19 | * maxpoint maximum number of starting points * | |
| 20 | * pi PI=3.14 * | |
| 21 | * * | |
| 22 | ******************************************************************************** | |
| 23 | ||
| 24 | include 'includepar' | |
| 25 | include 'includecom' | |
| 26 | ||
| 27 | integer i,j,k | |
| 28 | character*4 ii | |
| 29 | real phi | |
| 30 | ||
| 31 | ||
| 32 | do 20 i=1,numbunc | |
| 33 | phi=float(i)*2.*pi/float(numbunc) | |
| 34 | do 20 j=1,numpoint | |
| 35 | k=numpoint*i+j | |
| 36 | write(ii,'(i4.4)') i | |
| 37 | compoint(k)=compoint(j)(1:40)//'U'//ii | |
| 38 | xpoint(k)=xpoint(j)+distunc*sin(phi) | |
| 39 | ypoint(k)=ypoint(j)+distunc*cos(phi) | |
| 40 | zpoint(k)=zpoint(j) | |
| 41 | kind(k)=kind(j) | |
| 42 | kindz(k)=kindz(j) | |
| 43 | ||
| 44 | ||
| 45 | C Check if starting positions are inside grid | |
| 46 | ********************************************* | |
| 47 | ||
| 48 | if (xpoint(k).gt.float(nx-1)) xpoint(k)=float(nx-1)-.00001 | |
| 49 | if (ypoint(k).gt.float(ny-1)) ypoint(k)=float(ny-1)-.00001 | |
| 50 | if (xpoint(k).lt.0.) xpoint(k)=.00001 | |
| 51 | if (ypoint(k).lt.0.) ypoint(k)=.00001 | |
| 52 | ||
| 53 | 20 continue | |
| 54 | ||
| 55 | numpoint=numpoint*(1+numbunc) | |
| 56 | ||
| 57 | return | |
| 58 | end |
| 0 | subroutine utransform(uint,yt,dxdt) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE UTRANSFORM * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1994-02-14 * | |
| 9 | * LAST UPDATE: 1996-03-21 A. Stohl * | |
| 10 | * Runtime optimization * | |
| 11 | * * | |
| 12 | * * | |
| 13 | *********************************************************************** | |
| 14 | * * | |
| 15 | * DESCRIPTION: This subroutine transforms the interpolated zonal * | |
| 16 | * wind <uint> [m/s] to <dxdt> [grid units/time unit] * | |
| 17 | * xthelp help variable computed in readgrid * | |
| 18 | * * | |
| 19 | *********************************************************************** | |
| 20 | * * | |
| 21 | * INPUT: * | |
| 22 | * * | |
| 23 | * uint interpolated zonal wind component [m/s] * | |
| 24 | * * | |
| 25 | *********************************************************************** | |
| 26 | * * | |
| 27 | * OUTPUT: * | |
| 28 | * * | |
| 29 | * dxdt total differential in x direction [grid units/time unit] * | |
| 30 | * * | |
| 31 | *********************************************************************** | |
| 32 | * | |
| 33 | include 'includepar' | |
| 34 | include 'includecom' | |
| 35 | ||
| 36 | real uint,yt,dxdt,fact,pih | |
| 37 | parameter(pih=pi/180.) | |
| 38 | ||
| 39 | fact=max(cos((yt*dy+ylat0)*pih),1.e-4) | |
| 40 | ||
| 41 | dxdt=uint/fact*xthelp | |
| 42 | ||
| 43 | return | |
| 44 | end |
| 0 | subroutine vtransform(vint,dydt) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE VTRANSFORM * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1994-02-14 * | |
| 9 | * LAST UPDATE: 1996-03-21 * | |
| 10 | * Runtime optimization * | |
| 11 | * * | |
| 12 | *********************************************************************** | |
| 13 | * * | |
| 14 | * DESCRIPTION: This subroutine transforms the interpolated meridional * | |
| 15 | * wind <vint> [m/s] to <dydt> [grid units/time unit] * | |
| 16 | * ythelp help variable computed in readgrid * | |
| 17 | * * | |
| 18 | *********************************************************************** | |
| 19 | * * | |
| 20 | * INPUT: * | |
| 21 | * * | |
| 22 | * vint interpolated meridional wind component [m/s] * | |
| 23 | * * | |
| 24 | *********************************************************************** | |
| 25 | * * | |
| 26 | * OUTPUT: * | |
| 27 | * * | |
| 28 | * dydt total differential in y direction [grid units/time unit] * | |
| 29 | * * | |
| 30 | *********************************************************************** | |
| 31 | * | |
| 32 | include 'includepar' | |
| 33 | include 'includecom' | |
| 34 | ||
| 35 | real vint,dydt | |
| 36 | ||
| 37 | dydt=vint*ythelp | |
| 38 | ||
| 39 | return | |
| 40 | end |
| 0 | subroutine wtransform(wint,psint,zt,indwz,dzdt) | |
| 1 | *********************************************************************** | |
| 2 | * * | |
| 3 | * TRAJECTORY MODEL SUBROUTINE WTRANSFORM * | |
| 4 | * * | |
| 5 | *********************************************************************** | |
| 6 | * * | |
| 7 | * AUTHOR: G. WOTAWA * | |
| 8 | * DATE: 1994-02-14 * | |
| 9 | * LAST UPDATE: 1994-05-04 * | |
| 10 | * * | |
| 11 | *********************************************************************** | |
| 12 | * * | |
| 13 | * DESCRIPTION: This subroutine transforms the interpolated vertical * | |
| 14 | * wind <wint> from Pa/s to eta coordinte (vertical wind velocity is * | |
| 15 | * given as d(eta)/dt * dp/d(eta) [Pa/s]) * | |
| 16 | * * | |
| 17 | *********************************************************************** | |
| 18 | * * | |
| 19 | * INPUT: * | |
| 20 | * * | |
| 21 | * wint interpolated vertical wind component [Pa/s] * | |
| 22 | * psint interpolated surface pressure [Pa] * | |
| 23 | * zt vertical position of coordinate [eta] * | |
| 24 | * indwz index which shows between which model layers trajectory is * | |
| 25 | * situated * | |
| 26 | * * | |
| 27 | *********************************************************************** | |
| 28 | * * | |
| 29 | * OUTPUT: * | |
| 30 | * * | |
| 31 | * dzdt total differential in z direction [eta/time unit] * | |
| 32 | * * | |
| 33 | *********************************************************************** | |
| 34 | * | |
| 35 | include 'includepar' | |
| 36 | include 'includecom' | |
| 37 | ||
| 38 | integer indwz | |
| 39 | real wint,psint,zt,dzdt,p1,p2,eta1,eta2 | |
| 40 | real dpdeta,dpdeta1,dpdeta2,fract | |
| 41 | ||
| 42 | *********************************************************************** | |
| 43 | * * | |
| 44 | * CALCULATION OF dp/d(eta): CENTERED DIFFERENCES SCHEME USED * | |
| 45 | * * | |
| 46 | *********************************************************************** | |
| 47 | ||
| 48 | ||
| 49 | *********************************************************************** | |
| 50 | * * | |
| 51 | * CALCULATE dp/d(eta) FOR LEVEL <indwz> (FIRST LEVEL) * | |
| 52 | * * | |
| 53 | *********************************************************************** | |
| 54 | ||
| 55 | if(indwz.eq.1) then | |
| 56 | p1=akm(1)+bkm(1)*psint | |
| 57 | p2=akm(2)+bkm(2)*psint | |
| 58 | eta1=wheight(1)*zdirect | |
| 59 | eta2=wheight(2)*zdirect | |
| 60 | else | |
| 61 | p1=akm(indwz-1)+bkm(indwz-1)*psint | |
| 62 | p2=akm(indwz+1)+bkm(indwz+1)*psint | |
| 63 | eta1=wheight(indwz-1)*zdirect | |
| 64 | eta2=wheight(indwz+1)*zdirect | |
| 65 | endif | |
| 66 | dpdeta1=(p2-p1)/(eta2-eta1) | |
| 67 | ||
| 68 | *********************************************************************** | |
| 69 | * * | |
| 70 | * CALCULATE dp/d(eta) FOR LEVEL <indwz+1> (SECOND LEVEL) * | |
| 71 | * * | |
| 72 | *********************************************************************** | |
| 73 | ||
| 74 | if(indwz+1.eq.nwz) then | |
| 75 | p1=akm(nwz-1)+bkm(nwz-1)*psint | |
| 76 | p2=akm(nwz)+bkm(nwz)*psint | |
| 77 | eta1=wheight(nwz-1)*zdirect | |
| 78 | eta2=wheight(nwz)*zdirect | |
| 79 | else | |
| 80 | p1=akm(indwz)+bkm(indwz)*psint | |
| 81 | p2=akm(indwz+2)+bkm(indwz+2)*psint | |
| 82 | eta1=wheight(indwz)*zdirect | |
| 83 | eta2=wheight(indwz+2)*zdirect | |
| 84 | endif | |
| 85 | dpdeta2=(p2-p1)/(eta2-eta1) | |
| 86 | ||
| 87 | *********************************************************************** | |
| 88 | * * | |
| 89 | * LINEAR INTERPOLATION BETWEEN FIRST AND SECOND LEVEL * | |
| 90 | * * | |
| 91 | *********************************************************************** | |
| 92 | ||
| 93 | fract=(zt-wheight(indwz))/(wheight(indwz+1)-wheight(indwz)) | |
| 94 | dpdeta=dpdeta1*(1.-fract)+dpdeta2*fract | |
| 95 | ||
| 96 | *********************************************************************** | |
| 97 | * * | |
| 98 | * TRANSFORMATION OF <wint> TO d(eta)/dt (ECMWF COORDINATES) * | |
| 99 | * * | |
| 100 | *********************************************************************** | |
| 101 | ||
| 102 | dzdt=wint*zdirect/dpdeta | |
| 103 | ||
| 104 | return | |
| 105 | end |
| 0 | subroutine zztrafo(ngrid,xt,yt,zt,itime1,itime2,itime,indexf, | |
| 1 | +psint,ht) | |
| 2 | *********************************************************************** | |
| 3 | * * | |
| 4 | * TRAJECTORY MODEL SUBROUTINE ZZTRAFO * | |
| 5 | * * | |
| 6 | *********************************************************************** | |
| 7 | * * | |
| 8 | * AUTHOR: G. WOTAWA * | |
| 9 | * DATE: 1994-04-07 * | |
| 10 | * LAST UPDATE: 1999-01-07 Adaptation to nesting * | |
| 11 | * * | |
| 12 | *********************************************************************** | |
| 13 | * * | |
| 14 | * DESCRIPTION: This subroutine transforms the vertical coordinate * | |
| 15 | * eta (ECMWF) to geometric height [m] above model * | |
| 16 | * orography (relative height) * | |
| 17 | * Method: vertical integration of hydrostatic equation * | |
| 18 | * * | |
| 19 | * REMARK: For the calculation of geometric height, the virtual * | |
| 20 | * temperature difference has been neglected. The gas constant * | |
| 21 | * for dry air has been used. * | |
| 22 | * * | |
| 23 | *********************************************************************** | |
| 24 | * * | |
| 25 | * INPUT: * | |
| 26 | * * | |
| 27 | * ngrid number of nesting level to be used * | |
| 28 | * xt x-coordinate of point [grid units] * | |
| 29 | * yt y-coordinate of point [grid units] * | |
| 30 | * zt z-coordinate of point [eta (ECMWF)] * | |
| 31 | * itime1 time [s] of first windfield * | |
| 32 | * itime2 time [s] of second windfield * | |
| 33 | * itime time [s] of calculation * | |
| 34 | * indexf time index of field xx * | |
| 35 | * psint surface pressure at point (xt,yt) [Pa] * | |
| 36 | * * | |
| 37 | *********************************************************************** | |
| 38 | * * | |
| 39 | * OUTPUT: * | |
| 40 | * * | |
| 41 | * ht geometric height [m] * | |
| 42 | * * | |
| 43 | *********************************************************************** | |
| 44 | * | |
| 45 | include 'includepar' | |
| 46 | include 'includecom' | |
| 47 | ||
| 48 | integer itime1,itime2,itime,indexf,i,k,ngrid | |
| 49 | real xt,yt,zt,ht,psint,fract,pp1,pp2,tv | |
| 50 | ||
| 51 | real tlev(nuvzmax) | |
| 52 | real zzlev1,zzlev2 | |
| 53 | ||
| 54 | do 10 k=2,nwz | |
| 55 | if(zt.le.wheight(k)) goto 20 | |
| 56 | 10 continue | |
| 57 | k=nwz | |
| 58 | 20 fract=(zt-wheight(k-1))/(wheight(k)-wheight(k-1)) | |
| 59 | * | |
| 60 | * calculate interpolated vertical temperature profile on model levels | |
| 61 | * | |
| 62 | do 30 i=1,k-1 | |
| 63 | if (ngrid.gt.0) then | |
| 64 | call levlininterpoln(ttn,maxnests,nxmaxn,nymaxn,nuvzmax,ngrid, | |
| 65 | + nxn,nyn,memind,xt,yt,i,itime1,itime2,itime,indexf,tlev(i)) | |
| 66 | else | |
| 67 | call levlininterpol(tt,nxmax,nymax,nuvzmax,nx,ny,memind, | |
| 68 | + xt,yt,i,itime1,itime2,itime,indexf,tlev(i)) | |
| 69 | endif | |
| 70 | 30 continue | |
| 71 | * | |
| 72 | * calculate layer indices between which zt is situated | |
| 73 | * | |
| 74 | zzlev1=0 | |
| 75 | do 40 i=2,k-1 | |
| 76 | pp1=akm(i-1)+bkm(i-1)*psint | |
| 77 | pp2=akm(i)+bkm(i)*psint | |
| 78 | tv=tlev(i-1) | |
| 79 | 40 zzlev1=zzlev1+r_air/ga*log(pp1/pp2)*tv | |
| 80 | pp1=akm(k-1)+bkm(k-1)*psint | |
| 81 | pp2=akm(k) +bkm(k)*psint | |
| 82 | tv=tlev(k-1) | |
| 83 | zzlev2=zzlev1+r_air/ga*log(pp1/pp2)*tv | |
| 84 | ||
| 85 | ht=zzlev1*(1.-fract)+zzlev2*fract | |
| 86 | return | |
| 87 | end |