[135] | 1 | SUBROUTINE disvert |
---|
| 2 | |
---|
[253] | 3 | ! to use 'getin' |
---|
| 4 | USE ioipsl_getincom |
---|
[1397] | 5 | USE callkeys_mod, ONLY: kastprof,pceil |
---|
[1422] | 6 | USE comvert_mod, ONLY: ap,bp,sig,nivsigs,nivsig,pa,preff, |
---|
[1621] | 7 | . aps,bps,presnivs,pseudoalt,scaleheight |
---|
[253] | 8 | |
---|
[135] | 9 | c Auteur : F. Forget Y. Wanherdrick, P. Levan |
---|
| 10 | c Nouvelle version 100% Mars !! |
---|
| 11 | |
---|
[1422] | 12 | USE comconst_mod, ONLY: pi |
---|
| 13 | USE logic_mod, ONLY: autozlevs,hybrid |
---|
| 14 | |
---|
[135] | 15 | IMPLICIT NONE |
---|
| 16 | |
---|
| 17 | #include "dimensions.h" |
---|
| 18 | #include "paramet.h" |
---|
[253] | 19 | |
---|
| 20 | |
---|
[135] | 21 | c |
---|
| 22 | c======================================================================= |
---|
| 23 | c Discretisation verticale en coordonnée hybride OU sigma |
---|
| 24 | c |
---|
| 25 | c======================================================================= |
---|
| 26 | c |
---|
| 27 | c declarations: |
---|
| 28 | c ------------- |
---|
| 29 | c |
---|
| 30 | c |
---|
| 31 | INTEGER l,ll |
---|
| 32 | REAL snorm |
---|
[1621] | 33 | REAL alpha,beta,gama,delta,deltaz,quoi,quand |
---|
[135] | 34 | REAL zsig(llm) |
---|
| 35 | INTEGER np,ierr |
---|
[253] | 36 | integer :: ierr1,ierr2,ierr3,ierr4 |
---|
[135] | 37 | REAL x |
---|
| 38 | |
---|
| 39 | REAL SSUM |
---|
| 40 | EXTERNAL SSUM |
---|
| 41 | real newsig |
---|
| 42 | REAL dz0,dz1,nhaut,sig1,esig,csig,zz |
---|
| 43 | real tt,rr,gg, prevz |
---|
| 44 | real s(llm),dsig(llm) |
---|
| 45 | |
---|
| 46 | integer iz |
---|
| 47 | real z, ps,p |
---|
| 48 | |
---|
[253] | 49 | |
---|
| 50 | real psurf, hmax ! for autozlevs |
---|
| 51 | |
---|
[135] | 52 | c |
---|
| 53 | c----------------------------------------------------------------------- |
---|
| 54 | c |
---|
| 55 | pi=2.*ASIN(1.) |
---|
| 56 | |
---|
[253] | 57 | open(99,file="z2sig.def",status='old',form='formatted', |
---|
| 58 | s iostat=ierr4) |
---|
[135] | 59 | |
---|
| 60 | |
---|
[253] | 61 | autozlevs=.false. |
---|
| 62 | PRINT *,'Auto-discretise vertical levels ?' |
---|
| 63 | call getin("autozlevs",autozlevs) |
---|
| 64 | write(*,*) " autozlevs = ", autozlevs |
---|
[135] | 65 | |
---|
[253] | 66 | write(*,*)"Operate in kastprof mode?" |
---|
| 67 | kastprof=.false. |
---|
| 68 | call getin("kastprof",kastprof) |
---|
| 69 | write(*,*)" kastprof = ",kastprof |
---|
[135] | 70 | |
---|
[253] | 71 | print*,'kast=',kastprof |
---|
[135] | 72 | |
---|
[253] | 73 | pceil=100.0 ! Pascals |
---|
| 74 | PRINT *,'Ceiling pressure (Pa) ?' |
---|
| 75 | call getin("pceil",pceil) |
---|
| 76 | write(*,*) " pceil = ", pceil |
---|
[135] | 77 | |
---|
[253] | 78 | if(autozlevs.and.iim.gt.1)then |
---|
| 79 | print*,'autozlevs no good in 3D...' |
---|
| 80 | call abort |
---|
| 81 | endif |
---|
[135] | 82 | |
---|
[253] | 83 | if(kastprof.and.iim.gt.1)then |
---|
| 84 | print*,'kastprof no good in 3D...' |
---|
| 85 | call abort |
---|
| 86 | endif |
---|
[135] | 87 | |
---|
[253] | 88 | psurf=610. ! default value for psurf |
---|
| 89 | PRINT *,'Surface pressure (Pa) ?' |
---|
| 90 | call getin("psurf",psurf) |
---|
| 91 | write(*,*) " psurf = ",psurf |
---|
[135] | 92 | |
---|
[253] | 93 | if(kastprof)then |
---|
[135] | 94 | |
---|
[253] | 95 | sig(1)=1 |
---|
| 96 | do l=2,llm |
---|
| 97 | !sig(l)=1. - real(l-1)/real(llm) ! uses linear sigma spacing |
---|
| 98 | !sig(l)=exp(-real(l-1)*h/real(llm)) ! uses log sigma spacing |
---|
| 99 | !sig(l)=exp(-real(l-1)*Hmax/real(llm)) ! uses log sigma spacing |
---|
| 100 | sig(l)=(pceil/psurf)**(real(l-1)/real(llm)) ! uses log sigma spacing |
---|
| 101 | |
---|
| 102 | end do |
---|
| 103 | sig(llm+1)=0 |
---|
[135] | 104 | |
---|
[253] | 105 | elseIF(ierr4.eq.0)then |
---|
[135] | 106 | PRINT*,'****************************' |
---|
| 107 | PRINT*,'Lecture de z2sig.def' |
---|
| 108 | PRINT*,'****************************' |
---|
| 109 | |
---|
[1621] | 110 | READ(99,*) scaleheight |
---|
[135] | 111 | do l=1,llm |
---|
| 112 | read(99,*) zsig(l) |
---|
| 113 | end do |
---|
| 114 | CLOSE(99) |
---|
| 115 | |
---|
[253] | 116 | |
---|
| 117 | if(autozlevs)then |
---|
| 118 | open(91,file="z2sig.def",form='formatted') |
---|
[1621] | 119 | read(91,*) scaleheight |
---|
[253] | 120 | DO l=1,llm-2 |
---|
| 121 | read(91,*) Hmax |
---|
| 122 | enddo |
---|
| 123 | close(91) |
---|
| 124 | |
---|
| 125 | print*,'Hmax = ',Hmax,' km' |
---|
| 126 | print*,'Auto-shifting h in disvert.F to:' |
---|
| 127 | ! h = Hmax / log(psurf/100.0) |
---|
[1621] | 128 | scaleheight = Hmax / log(psurf/pceil) |
---|
| 129 | print*,'h = ',scaleheight,' km' |
---|
[253] | 130 | endif |
---|
| 131 | |
---|
| 132 | sig(1)=1 |
---|
| 133 | do l=2,llm |
---|
[1621] | 134 | sig(l) = 0.5 * ( exp(-zsig(l)/scaleheight) + |
---|
| 135 | & exp(-zsig(l-1)/scaleheight) ) |
---|
[253] | 136 | end do |
---|
| 137 | sig(llm+1)=0 |
---|
[135] | 138 | |
---|
| 139 | c----------------------------------------------------------------------- |
---|
| 140 | ELSE |
---|
[253] | 141 | write(*,*) 'didn_t you forget something?' |
---|
| 142 | write(*,*) 'We need the file z2sig.def!'! (OR esasig.def) ' |
---|
[135] | 143 | stop |
---|
| 144 | ENDIF |
---|
| 145 | c----------------------------------------------------------------------- |
---|
| 146 | |
---|
| 147 | |
---|
| 148 | DO l=1,llm |
---|
| 149 | nivsigs(l) = FLOAT(l) |
---|
| 150 | ENDDO |
---|
| 151 | |
---|
| 152 | DO l=1,llmp1 |
---|
| 153 | nivsig(l)= FLOAT(l) |
---|
| 154 | ENDDO |
---|
| 155 | |
---|
| 156 | |
---|
| 157 | c----------------------------------------------------------------------- |
---|
| 158 | c .... Calculs de ap(l) et de bp(l) .... |
---|
| 159 | c ......................................... |
---|
| 160 | c |
---|
| 161 | c ..... pa et preff sont lus sur les fichiers start par dynetat0 ..... |
---|
| 162 | c----------------------------------------------------------------------- |
---|
| 163 | c |
---|
| 164 | |
---|
| 165 | if (hybrid) then |
---|
| 166 | write(*,*) "*******************************" |
---|
| 167 | write(*,*) "Systeme en coordonnees hybrides" |
---|
| 168 | write(*,*) |
---|
| 169 | c Coordonnees hybrides avec mod |
---|
| 170 | DO l = 1, llm |
---|
| 171 | |
---|
| 172 | call sig_hybrid(sig(l),pa,preff,newsig) |
---|
| 173 | bp(l) = EXP( 1. - 1./(newsig**2) ) |
---|
| 174 | ap(l) = pa * (newsig - bp(l) ) |
---|
| 175 | enddo |
---|
| 176 | bp(llmp1) = 0. |
---|
| 177 | ap(llmp1) = 0. |
---|
| 178 | else |
---|
| 179 | write(*,*) "****************************" |
---|
| 180 | write(*,*) "Systeme en coordonnees sigma" |
---|
| 181 | write(*,*) |
---|
| 182 | c Pour ne pas passer en coordonnees hybrides |
---|
| 183 | DO l = 1, llm |
---|
| 184 | ap(l) = 0. |
---|
| 185 | bp(l) = sig(l) |
---|
| 186 | ENDDO |
---|
| 187 | ap(llmp1) = 0. |
---|
| 188 | endif |
---|
| 189 | |
---|
| 190 | bp(llmp1) = 0. |
---|
| 191 | |
---|
| 192 | PRINT *,' BP ' |
---|
| 193 | PRINT *, bp |
---|
| 194 | PRINT *,' AP ' |
---|
| 195 | PRINT *, ap |
---|
| 196 | |
---|
| 197 | c Calcul au milieu des couches : |
---|
| 198 | c WARNING : le choix de placer le milieu des couches au niveau de |
---|
| 199 | c pression intermédiaire est arbitraire et pourrait etre modifié. |
---|
| 200 | c Le calcul du niveau pour la derniere couche |
---|
| 201 | c (on met la meme distance (en log pression) entre P(llm) |
---|
| 202 | c et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est |
---|
| 203 | c Specifique. Ce choix est spécifié ici ET dans exner_hyb.F |
---|
| 204 | |
---|
| 205 | DO l = 1, llm-1 |
---|
| 206 | aps(l) = 0.5 *( ap(l) +ap(l+1)) |
---|
| 207 | bps(l) = 0.5 *( bp(l) +bp(l+1)) |
---|
| 208 | ENDDO |
---|
| 209 | |
---|
| 210 | if (hybrid) then |
---|
| 211 | aps(llm) = aps(llm-1)**2 / aps(llm-2) |
---|
| 212 | bps(llm) = 0.5*(bp(llm) + bp(llm+1)) |
---|
| 213 | else |
---|
| 214 | bps(llm) = bps(llm-1)**2 / bps(llm-2) |
---|
[253] | 215 | aps(llm) = 0. ! what the hell is this??? |
---|
[135] | 216 | end if |
---|
| 217 | |
---|
| 218 | PRINT *,' BPs ' |
---|
| 219 | PRINT *, bps |
---|
| 220 | PRINT *,' APs' |
---|
| 221 | PRINT *, aps |
---|
| 222 | |
---|
[253] | 223 | |
---|
[135] | 224 | DO l = 1, llm |
---|
| 225 | presnivs(l) = aps(l)+bps(l)*preff |
---|
[1621] | 226 | pseudoalt(l) = -scaleheight*log(presnivs(l)/preff) |
---|
[135] | 227 | ENDDO |
---|
| 228 | |
---|
| 229 | PRINT *,' PRESNIVS' |
---|
| 230 | PRINT *,presnivs |
---|
| 231 | PRINT *,'Pseudo altitude des Presnivs : ' |
---|
| 232 | PRINT *,pseudoalt |
---|
| 233 | |
---|
| 234 | |
---|
| 235 | c -------------------------------------------------- |
---|
| 236 | c This can be used to plot the vertical discretization |
---|
| 237 | c (> xmgrace -nxy testhybrid.tab (z = H*log(p(l)/pref)) |
---|
| 238 | c -------------------------------------------------- |
---|
| 239 | c open (53,file='testhybrid.tab') |
---|
| 240 | c do iz=0,60 |
---|
| 241 | c z = -10 + min(iz,60-iz) |
---|
| 242 | c ps = preff*exp(-z/10) |
---|
| 243 | c do l=1,llm |
---|
| 244 | c zsig(l)= -10.*log((aps(l) + bps(l)*ps)/preff) |
---|
| 245 | c end do |
---|
| 246 | c write(53,*)iz, (zsig(l),l=1,llm,1) |
---|
| 247 | c end do |
---|
| 248 | c close(53) |
---|
| 249 | c -------------------------------------------------- |
---|
| 250 | |
---|
| 251 | |
---|
| 252 | RETURN |
---|
| 253 | END |
---|
| 254 | |
---|
| 255 | c ************************************************************ |
---|
| 256 | subroutine sig_hybrid(sig,pa,preff,newsig) |
---|
| 257 | c ---------------------------------------------- |
---|
| 258 | c Subroutine utilisee pour calculer des valeurs de sigma modifie |
---|
| 259 | c pour conserver les coordonnees verticales decrites dans |
---|
| 260 | c esasig.def/z2sig.def lors du passage en coordonnees hybrides |
---|
| 261 | c F. Forget 2002 |
---|
| 262 | c Connaissant sig (niveaux "sigma" ou on veut mettre les couches) |
---|
| 263 | c L'objectif est de calculer newsig telle que |
---|
| 264 | c (1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig = sig |
---|
| 265 | c Cela ne se résoud pas analytiquement: |
---|
| 266 | c => on résoud par iterration bourrine |
---|
| 267 | c ---------------------------------------------- |
---|
| 268 | c Information : where exp(1-1./x**2) become << x |
---|
| 269 | c x exp(1-1./x**2) /x |
---|
| 270 | c 1 1 |
---|
| 271 | c 0.68 0.5 |
---|
| 272 | c 0.5 1.E-1 |
---|
| 273 | c 0.391 1.E-2 |
---|
| 274 | c 0.333 1.E-3 |
---|
| 275 | c 0.295 1.E-4 |
---|
| 276 | c 0.269 1.E-5 |
---|
| 277 | c 0.248 1.E-6 |
---|
| 278 | c => on peut utiliser newsig = sig*preff/pa si sig*preff/pa < 0.25 |
---|
| 279 | |
---|
| 280 | |
---|
| 281 | implicit none |
---|
| 282 | real x1, x2, sig,pa,preff, newsig, F |
---|
| 283 | integer j |
---|
| 284 | |
---|
| 285 | newsig = sig |
---|
| 286 | x1=0 |
---|
| 287 | x2=1 |
---|
| 288 | if (sig.ge.1) then |
---|
| 289 | newsig= sig |
---|
| 290 | else if (sig*preff/pa.ge.0.25) then |
---|
| 291 | DO J=1,9999 ! nombre d''iteration max |
---|
| 292 | F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig |
---|
| 293 | c write(0,*) J, ' newsig =', newsig, ' F= ', F |
---|
| 294 | if (F.gt.1) then |
---|
| 295 | X2 = newsig |
---|
| 296 | newsig=(X1+newsig)*0.5 |
---|
| 297 | else |
---|
| 298 | X1 = newsig |
---|
| 299 | newsig=(X2+newsig)*0.5 |
---|
| 300 | end if |
---|
| 301 | c Test : on arete lorsque on approxime sig à moins de 0.01 m près |
---|
| 302 | c (en pseudo altiude) : |
---|
| 303 | IF(abs(10.*log(F)).LT.1.E-5) goto 999 |
---|
| 304 | END DO |
---|
| 305 | else ! if (sig*preff/pa.le.0.25) then |
---|
| 306 | newsig= sig*preff/pa |
---|
| 307 | end if |
---|
| 308 | 999 continue |
---|
| 309 | Return |
---|
| 310 | END |
---|