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