| 1 | ! $Id: $ |
|---|
| 2 | SUBROUTINE disvert_noterre |
|---|
| 3 | |
|---|
| 4 | c Auteur : F. Forget Y. Wanherdrick, P. Levan |
|---|
| 5 | |
|---|
| 6 | #ifdef CPP_IOIPSL |
|---|
| 7 | use IOIPSL |
|---|
| 8 | #else |
|---|
| 9 | ! if not using IOIPSL, we still need to use (a local version of) getin |
|---|
| 10 | use ioipsl_getincom |
|---|
| 11 | #endif |
|---|
| 12 | USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt, |
|---|
| 13 | . nivsig,nivsigs,pa,preff,scaleheight |
|---|
| 14 | USE comconst_mod, ONLY: kappa |
|---|
| 15 | USE logic_mod, ONLY: hybrid |
|---|
| 16 | |
|---|
| 17 | IMPLICIT NONE |
|---|
| 18 | |
|---|
| 19 | #include "dimensions.h" |
|---|
| 20 | #include "paramet.h" |
|---|
| 21 | #include "iniprint.h" |
|---|
| 22 | c |
|---|
| 23 | c======================================================================= |
|---|
| 24 | c Vertical discretization for purely sigma or hybrid sigma-pressure |
|---|
| 25 | c coordinate depending on user provided flag "hybrid" |
|---|
| 26 | c======================================================================= |
|---|
| 27 | c |
|---|
| 28 | c declarations: |
|---|
| 29 | c ------------- |
|---|
| 30 | c |
|---|
| 31 | c |
|---|
| 32 | INTEGER l,ll |
|---|
| 33 | REAL snorm |
|---|
| 34 | REAL alpha,beta,gama,delta,deltaz |
|---|
| 35 | real quoi,quand |
|---|
| 36 | REAL zsig(llm),sig(llm+1) |
|---|
| 37 | INTEGER np,ierr |
|---|
| 38 | integer :: ierr1,ierr2,ierr3,ierr4 |
|---|
| 39 | REAL x |
|---|
| 40 | |
|---|
| 41 | REAL SSUM |
|---|
| 42 | EXTERNAL SSUM |
|---|
| 43 | real newsig |
|---|
| 44 | REAL dz0,dz1,nhaut,sig1,esig,csig,zz |
|---|
| 45 | real tt,rr,gg, prevz |
|---|
| 46 | real s(llm),dsig(llm) |
|---|
| 47 | |
|---|
| 48 | integer iz |
|---|
| 49 | real z, ps,p |
|---|
| 50 | character(len=*),parameter :: modname="disvert_noterre" |
|---|
| 51 | |
|---|
| 52 | c |
|---|
| 53 | c----------------------------------------------------------------------- |
|---|
| 54 | c |
|---|
| 55 | ! Initializations: |
|---|
| 56 | ! pi=2.*ASIN(1.) ! already done in iniconst |
|---|
| 57 | |
|---|
| 58 | hybrid=.true. ! default value for hybrid (ie: use hybrid coordinates) |
|---|
| 59 | CALL getin('hybrid',hybrid) |
|---|
| 60 | write(lunout,*) trim(modname),': hybrid=',hybrid |
|---|
| 61 | |
|---|
| 62 | ! Open file esasig.def, or if not there open z2sig.def |
|---|
| 63 | |
|---|
| 64 | open(99,file="esasig.def",status='old',form='formatted', |
|---|
| 65 | s iostat=ierr2) |
|---|
| 66 | if(ierr2.ne.0) then |
|---|
| 67 | close(99) |
|---|
| 68 | open(99,file="z2sig.def",status='old',form='formatted', |
|---|
| 69 | s iostat=ierr4) |
|---|
| 70 | endif |
|---|
| 71 | |
|---|
| 72 | c----------------------------------------------------------------------- |
|---|
| 73 | c case 1 read from esasig.def: |
|---|
| 74 | c ---------------------------------------- |
|---|
| 75 | |
|---|
| 76 | IF(ierr2.eq.0) then |
|---|
| 77 | |
|---|
| 78 | c Lecture de esasig.def : |
|---|
| 79 | c Systeme peu souple, mais qui respecte en theorie |
|---|
| 80 | c La conservation de l'energie (conversion Energie potentielle |
|---|
| 81 | c <-> energie cinetique, d'apres la note de Frederic Hourdin... |
|---|
| 82 | |
|---|
| 83 | write(lunout,*)'*****************************' |
|---|
| 84 | write(lunout,*)'WARNING reading esasig.def' |
|---|
| 85 | write(lunout,*)'*****************************' |
|---|
| 86 | READ(99,*) scaleheight |
|---|
| 87 | READ(99,*) dz0 |
|---|
| 88 | READ(99,*) dz1 |
|---|
| 89 | READ(99,*) nhaut |
|---|
| 90 | CLOSE(99) |
|---|
| 91 | |
|---|
| 92 | dz0=dz0/scaleheight |
|---|
| 93 | dz1=dz1/scaleheight |
|---|
| 94 | |
|---|
| 95 | sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut) |
|---|
| 96 | |
|---|
| 97 | esig=1. |
|---|
| 98 | |
|---|
| 99 | do l=1,20 |
|---|
| 100 | esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.) |
|---|
| 101 | enddo |
|---|
| 102 | csig=(1./sig1-1.)/(exp(esig)-1.) |
|---|
| 103 | |
|---|
| 104 | DO L = 2, llm |
|---|
| 105 | zz=csig*(exp(esig*(l-1.))-1.) |
|---|
| 106 | sig(l) =1./(1.+zz) |
|---|
| 107 | & * tanh(.5*(llm+1-l)/nhaut) |
|---|
| 108 | ENDDO |
|---|
| 109 | sig(1)=1. |
|---|
| 110 | sig(llm+1)=0. |
|---|
| 111 | quoi = 1. + 2.* kappa |
|---|
| 112 | s( llm ) = 1. |
|---|
| 113 | s(llm-1) = quoi |
|---|
| 114 | IF( llm.gt.2 ) THEN |
|---|
| 115 | DO ll = 2, llm-1 |
|---|
| 116 | l = llm+1 - ll |
|---|
| 117 | quand = sig(l+1)/ sig(l) |
|---|
| 118 | s(l-1) = quoi * (1.-quand) * s(l) + quand * s(l+1) |
|---|
| 119 | ENDDO |
|---|
| 120 | END IF |
|---|
| 121 | c |
|---|
| 122 | snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2) |
|---|
| 123 | DO l = 1, llm |
|---|
| 124 | s(l) = s(l)/ snorm |
|---|
| 125 | ENDDO |
|---|
| 126 | |
|---|
| 127 | c----------------------------------------------------------------------- |
|---|
| 128 | c case 2 read from z2sig.def: |
|---|
| 129 | c ---------------------------------------- |
|---|
| 130 | |
|---|
| 131 | ELSE IF(ierr4.eq.0) then |
|---|
| 132 | write(lunout,*)'****************************' |
|---|
| 133 | write(lunout,*)'Reading z2sig.def' |
|---|
| 134 | write(lunout,*)'****************************' |
|---|
| 135 | |
|---|
| 136 | READ(99,*) scaleheight |
|---|
| 137 | do l=1,llm |
|---|
| 138 | read(99,*,iostat=ierr1) zsig(l) |
|---|
| 139 | if (ierr1 .ne. 0) then |
|---|
| 140 | write(lunout,*) 'ERROR with line ', l,' of z2sig.def' |
|---|
| 141 | call abort_gcm(modname, "z2sig.def too short?", 1) |
|---|
| 142 | endif |
|---|
| 143 | end do |
|---|
| 144 | ! Check if there are more lines to read in the file |
|---|
| 145 | read(99,*,iostat=ierr1) |
|---|
| 146 | if (ierr1 .eq. 0) then |
|---|
| 147 | write(lunout,*) 'WARNING: More lines in z2sig.def' |
|---|
| 148 | & //' than expected from nb of levels:', llm |
|---|
| 149 | ! call abort_gcm(modname, |
|---|
| 150 | ! & 'z2sig.def has more lines than expected', 1) |
|---|
| 151 | endif |
|---|
| 152 | CLOSE(99) |
|---|
| 153 | |
|---|
| 154 | sig(1) =1 |
|---|
| 155 | do l=2,llm |
|---|
| 156 | sig(l) = 0.5 * ( exp(-zsig(l)/scaleheight) + |
|---|
| 157 | & exp(-zsig(l-1)/scaleheight) ) |
|---|
| 158 | end do |
|---|
| 159 | sig(llm+1) =0 |
|---|
| 160 | |
|---|
| 161 | c----------------------------------------------------------------------- |
|---|
| 162 | ELSE |
|---|
| 163 | write(lunout,*) 'didn t you forget something ??? ' |
|---|
| 164 | write(lunout,*) 'We need file z2sig.def ! (OR esasig.def)' |
|---|
| 165 | stop |
|---|
| 166 | ENDIF |
|---|
| 167 | c----------------------------------------------------------------------- |
|---|
| 168 | |
|---|
| 169 | DO l=1,llm |
|---|
| 170 | nivsigs(l) = REAL(l) |
|---|
| 171 | ENDDO |
|---|
| 172 | |
|---|
| 173 | DO l=1,llmp1 |
|---|
| 174 | nivsig(l)= REAL(l) |
|---|
| 175 | ENDDO |
|---|
| 176 | |
|---|
| 177 | |
|---|
| 178 | c----------------------------------------------------------------------- |
|---|
| 179 | c .... Compute ap(l) and bp(l) .... |
|---|
| 180 | c ......................................... |
|---|
| 181 | c |
|---|
| 182 | c ..... note that pa and preff are from start file read by dynetat0 |
|---|
| 183 | c----------------------------------------------------------------------- |
|---|
| 184 | c |
|---|
| 185 | |
|---|
| 186 | if (hybrid) then ! use hybrid coordinates |
|---|
| 187 | write(lunout,*) "*********************************" |
|---|
| 188 | write(lunout,*) "Using hybrid vertical coordinates" |
|---|
| 189 | write(lunout,*) |
|---|
| 190 | c Coordonnees hybrides avec mod |
|---|
| 191 | DO l = 1, llm |
|---|
| 192 | |
|---|
| 193 | call sig_hybrid(sig(l),pa,preff,newsig) |
|---|
| 194 | bp(l) = EXP( 1. - 1./(newsig**2) ) |
|---|
| 195 | ap(l) = pa * (newsig - bp(l) ) |
|---|
| 196 | enddo |
|---|
| 197 | bp(llmp1) = 0. |
|---|
| 198 | ap(llmp1) = 0. |
|---|
| 199 | else ! use sigma coordinates |
|---|
| 200 | write(lunout,*) "********************************" |
|---|
| 201 | write(lunout,*) "Using sigma vertical coordinates" |
|---|
| 202 | write(lunout,*) |
|---|
| 203 | c Pour ne pas passer en coordonnees hybrides |
|---|
| 204 | DO l = 1, llm |
|---|
| 205 | ap(l) = 0. |
|---|
| 206 | bp(l) = sig(l) |
|---|
| 207 | ENDDO |
|---|
| 208 | ap(llmp1) = 0. |
|---|
| 209 | endif |
|---|
| 210 | |
|---|
| 211 | bp(llmp1) = 0. |
|---|
| 212 | |
|---|
| 213 | write(lunout,*) trim(modname),': BP ' |
|---|
| 214 | write(lunout,*) bp |
|---|
| 215 | write(lunout,*) trim(modname),': AP ' |
|---|
| 216 | write(lunout,*) ap |
|---|
| 217 | |
|---|
| 218 | c Compute value at the mid-layer : |
|---|
| 219 | c WARNING : there is an arbitrary decision here to put the |
|---|
| 220 | c middle of the layer half-way (pressure-wise) between boundaries |
|---|
| 221 | c In addition for the last layer (the top of which is at zero pressure) |
|---|
| 222 | c P(llm), we choose to put it with the same interval (in log(pressure)) |
|---|
| 223 | c from P(llm-1), than there is between between P(llm-1) and P(llm-2) |
|---|
| 224 | c This choice is quite specific and is done here AND in exner_milieu.F |
|---|
| 225 | c Both routines should definitely use the same assumptions. |
|---|
| 226 | |
|---|
| 227 | DO l = 1, llm-1 |
|---|
| 228 | aps(l) = 0.5 *( ap(l) +ap(l+1)) |
|---|
| 229 | bps(l) = 0.5 *( bp(l) +bp(l+1)) |
|---|
| 230 | ENDDO |
|---|
| 231 | |
|---|
| 232 | if (hybrid) then |
|---|
| 233 | aps(llm) = aps(llm-1)**2 / aps(llm-2) |
|---|
| 234 | bps(llm) = 0.5*(bp(llm) + bp(llm+1)) |
|---|
| 235 | else |
|---|
| 236 | bps(llm) = bps(llm-1)**2 / bps(llm-2) |
|---|
| 237 | aps(llm) = 0. |
|---|
| 238 | end if |
|---|
| 239 | |
|---|
| 240 | write(lunout,*) trim(modname),': BPs ' |
|---|
| 241 | write(lunout,*) bps |
|---|
| 242 | write(lunout,*) trim(modname),': APs' |
|---|
| 243 | write(lunout,*) aps |
|---|
| 244 | |
|---|
| 245 | DO l = 1, llm |
|---|
| 246 | presnivs(l) = aps(l)+bps(l)*preff |
|---|
| 247 | pseudoalt(l) = -scaleheight*log(presnivs(l)/preff) |
|---|
| 248 | ENDDO |
|---|
| 249 | |
|---|
| 250 | write(lunout,*)trim(modname),' : PRESNIVS' |
|---|
| 251 | write(lunout,*)presnivs |
|---|
| 252 | write(lunout,*)'Pseudo altitude of Presnivs : (for a scale ', |
|---|
| 253 | & 'height of ',scaleheight,' km)' |
|---|
| 254 | write(lunout,*)pseudoalt |
|---|
| 255 | |
|---|
| 256 | c -------------------------------------------------- |
|---|
| 257 | c This can be used to plot the vertical discretization |
|---|
| 258 | c (> xmgrace -nxy testhybrid.tab ) |
|---|
| 259 | c -------------------------------------------------- |
|---|
| 260 | c open (53,file='testhybrid.tab') |
|---|
| 261 | c scaleheight=15.5 |
|---|
| 262 | c do iz=0,34 |
|---|
| 263 | c z = -5 + min(iz,34-iz) |
|---|
| 264 | c approximation of scale height for Venus |
|---|
| 265 | c scaleheight = 15.5 - z/55.*10. |
|---|
| 266 | c ps = preff*exp(-z/scaleheight) |
|---|
| 267 | c zsig(1)= -scaleheight*log((aps(1) + bps(1)*ps)/preff) |
|---|
| 268 | c do l=2,llm |
|---|
| 269 | c approximation of scale height for Venus |
|---|
| 270 | c if (zsig(l-1).le.55.) then |
|---|
| 271 | c scaleheight = 15.5 - zsig(l-1)/55.*10. |
|---|
| 272 | c else |
|---|
| 273 | c scaleheight = 5.5 - (zsig(l-1)-55.)/35.*2. |
|---|
| 274 | c endif |
|---|
| 275 | c zsig(l)= zsig(l-1)-scaleheight* |
|---|
| 276 | c . log((aps(l) + bps(l)*ps)/(aps(l-1) + bps(l-1)*ps)) |
|---|
| 277 | c end do |
|---|
| 278 | c write(53,'(I3,50F10.5)') iz, zsig |
|---|
| 279 | c end do |
|---|
| 280 | c close(53) |
|---|
| 281 | c -------------------------------------------------- |
|---|
| 282 | |
|---|
| 283 | |
|---|
| 284 | END |
|---|
| 285 | |
|---|
| 286 | c ************************************************************ |
|---|
| 287 | subroutine sig_hybrid(sig,pa,preff,newsig) |
|---|
| 288 | c ---------------------------------------------- |
|---|
| 289 | c Subroutine utilisee pour calculer des valeurs de sigma modifie |
|---|
| 290 | c pour conserver les coordonnees verticales decrites dans |
|---|
| 291 | c esasig.def/z2sig.def lors du passage en coordonnees hybrides |
|---|
| 292 | c F. Forget 2002 |
|---|
| 293 | c Knowing sig (the "sigma" levels where we want to put the layers) |
|---|
| 294 | c The goal is to compute newsig such that |
|---|
| 295 | c (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig |
|---|
| 296 | c Which cannot be done analyticaly: |
|---|
| 297 | c => need for an iterative procedure |
|---|
| 298 | c ---------------------------------------------- |
|---|
| 299 | c Information : when exp(1-1./x**2) becomes << x |
|---|
| 300 | c x exp(1-1./x**2) /x |
|---|
| 301 | c 1 1 |
|---|
| 302 | c 0.68 0.5 |
|---|
| 303 | c 0.5 1.E-1 |
|---|
| 304 | c 0.391 1.E-2 |
|---|
| 305 | c 0.333 1.E-3 |
|---|
| 306 | c 0.295 1.E-4 |
|---|
| 307 | c 0.269 1.E-5 |
|---|
| 308 | c 0.248 1.E-6 |
|---|
| 309 | c => one can thus use newsig = sig*preff/pa if sig*preff/pa < 0.25 |
|---|
| 310 | |
|---|
| 311 | |
|---|
| 312 | implicit none |
|---|
| 313 | real x1, x2, sig,pa,preff, newsig, F |
|---|
| 314 | integer j |
|---|
| 315 | |
|---|
| 316 | newsig = sig |
|---|
| 317 | x1=0 |
|---|
| 318 | x2=1 |
|---|
| 319 | if (sig.ge.1) then |
|---|
| 320 | newsig= sig |
|---|
| 321 | else if (sig*preff/pa.ge.0.25) then |
|---|
| 322 | DO J=1,9999 ! overkill maximum number of iterations |
|---|
| 323 | F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig |
|---|
| 324 | c write(0,*) J, ' newsig =', newsig, ' F= ', F |
|---|
| 325 | if (F.gt.1) then |
|---|
| 326 | X2 = newsig |
|---|
| 327 | newsig=(X1+newsig)*0.5 |
|---|
| 328 | else |
|---|
| 329 | X1 = newsig |
|---|
| 330 | newsig=(X2+newsig)*0.5 |
|---|
| 331 | end if |
|---|
| 332 | c Convergence is assumed if sig is within 0.01m (in pseudo-altitude) |
|---|
| 333 | c of the target value. |
|---|
| 334 | IF(abs(10.*log(F)).LT.1.E-5) goto 999 |
|---|
| 335 | END DO |
|---|
| 336 | else ! if (sig*preff/pa.le.0.25) then |
|---|
| 337 | newsig= sig*preff/pa |
|---|
| 338 | end if |
|---|
| 339 | 999 continue |
|---|
| 340 | |
|---|
| 341 | END |
|---|
