| [135] | 1 | SUBROUTINE disvert |
|---|
| 2 | |
|---|
| 3 | c Auteur : P. Le Van . F. Forget Y. Wanherdrick |
|---|
| 4 | c Many modif special mars !! |
|---|
| 5 | |
|---|
| 6 | IMPLICIT NONE |
|---|
| 7 | |
|---|
| 8 | #include "dimensions.h" |
|---|
| 9 | #include "paramet.h" |
|---|
| 10 | #include "comvert.h" |
|---|
| 11 | #include "comconst.h" |
|---|
| 12 | #include "hybrid.h" |
|---|
| 13 | c |
|---|
| 14 | c======================================================================= |
|---|
| 15 | c Discretisation verticale en coordonnée hybride |
|---|
| 16 | c |
|---|
| 17 | c======================================================================= |
|---|
| 18 | c |
|---|
| 19 | c declarations: |
|---|
| 20 | c ------------- |
|---|
| 21 | c |
|---|
| 22 | c |
|---|
| 23 | INTEGER l,ll |
|---|
| 24 | REAL snorm |
|---|
| 25 | REAL alpha,beta,gama,delta,deltaz,h,zsig,quoi,quand |
|---|
| 26 | INTEGER np,ierr |
|---|
| 27 | integer :: ierr1,ierr2,ierr3,ierr4 |
|---|
| 28 | REAL x |
|---|
| 29 | |
|---|
| 30 | REAL SSUM |
|---|
| 31 | EXTERNAL SSUM |
|---|
| 32 | real newsig |
|---|
| 33 | REAL dz0,dz1,nhaut,sig1,esig,csig,zz |
|---|
| 34 | real tt,rr,gg, prevz |
|---|
| 35 | real s(llm),dsig(llm) |
|---|
| 36 | |
|---|
| 37 | c |
|---|
| 38 | c----------------------------------------------------------------------- |
|---|
| 39 | c |
|---|
| 40 | pi=2.*ASIN(1.) |
|---|
| 41 | |
|---|
| 42 | open(99,file="sigma.def",status='old',form='formatted', |
|---|
| 43 | s iostat=ierr1) |
|---|
| 44 | ! Ouverture possible de fichiers typiquement E.T. |
|---|
| 45 | |
|---|
| 46 | if(ierr1.ne.0) then |
|---|
| 47 | close(99) |
|---|
| 48 | open(99,file="esasig.def",status='old',form='formatted', |
|---|
| 49 | s iostat=ierr2) |
|---|
| 50 | if(ierr2.ne.0) then |
|---|
| 51 | close(99) |
|---|
| 52 | open(99,file="tritonsig.def",status='old',form='formatted', |
|---|
| 53 | s iostat=ierr3) |
|---|
| 54 | if(ierr3.ne.0) then |
|---|
| 55 | close(99) |
|---|
| 56 | open(99,file="z2sig.def",status='old',form='formatted', |
|---|
| 57 | s iostat=ierr4) |
|---|
| 58 | endif |
|---|
| 59 | endif |
|---|
| 60 | endif |
|---|
| 61 | |
|---|
| 62 | c----------------------------------------------------------------------- |
|---|
| 63 | c cas 1 on lit les options dans sigma.def: |
|---|
| 64 | c ---------------------------------------- |
|---|
| 65 | |
|---|
| 66 | IF (ierr1.eq.0) THEN |
|---|
| 67 | |
|---|
| 68 | PRINT*,'*****************************' |
|---|
| 69 | PRINT*,'WARNING Lecture de sigma.def' |
|---|
| 70 | PRINT*,'*****************************' |
|---|
| 71 | READ(99,*) deltaz |
|---|
| 72 | READ(99,*) h |
|---|
| 73 | READ(99,*) beta |
|---|
| 74 | READ(99,*) gama |
|---|
| 75 | READ(99,*) delta |
|---|
| 76 | READ(99,*) np |
|---|
| 77 | CLOSE(99) |
|---|
| 78 | alpha=deltaz/(llm*h) |
|---|
| 79 | c |
|---|
| 80 | |
|---|
| 81 | DO l = 1, llm |
|---|
| 82 | dsig(l) = (alpha+(1.-alpha)*exp(-beta*(llm-l)))* |
|---|
| 83 | $ ( (tanh(gama*l)/tanh(gama*llm))**np + |
|---|
| 84 | $ (1.-l/FLOAT(llm))*delta ) |
|---|
| 85 | ENDDO |
|---|
| 86 | |
|---|
| 87 | sig(1)=1. |
|---|
| 88 | DO l=1,llm-1 |
|---|
| 89 | sig(l+1)=sig(l)*(1.-dsig(l))/(1.+dsig(l)) |
|---|
| 90 | ENDDO |
|---|
| 91 | sig(llm+1)=0. |
|---|
| 92 | |
|---|
| 93 | c |
|---|
| 94 | |
|---|
| 95 | ! Debut de la partie martienne pour lecture de esasig.def |
|---|
| 96 | c========================================================= |
|---|
| 97 | |
|---|
| 98 | ELSE IF(ierr2.eq.0) then |
|---|
| 99 | |
|---|
| 100 | PRINT*,'*****************************' |
|---|
| 101 | PRINT*,'WARNING Lecture de esasig.def' |
|---|
| 102 | PRINT*,'*****************************' |
|---|
| 103 | READ(99,*) h |
|---|
| 104 | READ(99,*) dz0 |
|---|
| 105 | READ(99,*) dz1 |
|---|
| 106 | READ(99,*) nhaut |
|---|
| 107 | CLOSE(99) |
|---|
| 108 | |
|---|
| 109 | dz0=dz0/h |
|---|
| 110 | dz1=dz1/h |
|---|
| 111 | |
|---|
| 112 | sig1=(1.-dz1)/tanh(.5*(llm-1)/nhaut) |
|---|
| 113 | |
|---|
| 114 | esig=1. |
|---|
| 115 | |
|---|
| 116 | PRINT* |
|---|
| 117 | do l=1,20 |
|---|
| 118 | esig=-log((1./sig1-1.)*exp(-dz0)/esig)/(llm-1.) |
|---|
| 119 | enddo |
|---|
| 120 | print*,'esig=',esig |
|---|
| 121 | PRINT* |
|---|
| 122 | csig=(1./sig1-1.)/(exp(esig)-1.) |
|---|
| 123 | |
|---|
| 124 | DO L = 2, llm |
|---|
| 125 | zz=csig*(exp(esig*(l-1.))-1.) |
|---|
| 126 | sig(l) =1./(1.+zz) |
|---|
| 127 | & * tanh(.5*(llm+1-l)/nhaut) |
|---|
| 128 | ENDDO |
|---|
| 129 | sig(1)=1. |
|---|
| 130 | sig(llm+1)=0. |
|---|
| 131 | |
|---|
| 132 | c Fin de la partie martienne |
|---|
| 133 | c ========================== |
|---|
| 134 | |
|---|
| 135 | ELSE IF(ierr3.eq.0) then |
|---|
| 136 | |
|---|
| 137 | PRINT*,'********************************' |
|---|
| 138 | PRINT*,'WARNING Lecture de tritonsig.def' |
|---|
| 139 | PRINT*,'********************************' |
|---|
| 140 | PRINT*,'kappa=', kappa |
|---|
| 141 | READ(99,*) gg |
|---|
| 142 | READ(99,*) rr |
|---|
| 143 | sig(1)=1. |
|---|
| 144 | prevz=0. |
|---|
| 145 | do l=1,llm-1 |
|---|
| 146 | read(99,*) zz, tt |
|---|
| 147 | sig(l+1) = sig(l)* exp(-(zz-prevz)*gg/(rr*tt)) |
|---|
| 148 | prevz=zz |
|---|
| 149 | if(l.eq.llm/2)h =1.e-3* rr*tt/gg |
|---|
| 150 | end do |
|---|
| 151 | sig(llm+1)=0. |
|---|
| 152 | CLOSE(99) |
|---|
| 153 | |
|---|
| 154 | ELSE IF(ierr4.eq.0) then |
|---|
| 155 | PRINT*,'****************************' |
|---|
| 156 | PRINT*,'WARNING Lecture de z2sig.def' |
|---|
| 157 | PRINT*,'****************************' |
|---|
| 158 | |
|---|
| 159 | |
|---|
| 160 | READ(99,*) h |
|---|
| 161 | do l=1,llm |
|---|
| 162 | read(99,*) zsig |
|---|
| 163 | s(l) = exp(-kappa*zsig/h) |
|---|
| 164 | end do |
|---|
| 165 | CLOSE(99) |
|---|
| 166 | |
|---|
| 167 | sig(1) =1 |
|---|
| 168 | do l=2,llm |
|---|
| 169 | sig(l) = 0.5 * (s(l)**(1/kappa)+s(l-1)**(1/kappa)) |
|---|
| 170 | end do |
|---|
| 171 | sig(llm+1) =0 |
|---|
| 172 | |
|---|
| 173 | ELSE |
|---|
| 174 | c----------------------------------------------------------------------- |
|---|
| 175 | c cas 2 ancienne discretisation (LMD5...): |
|---|
| 176 | c ---------------------------------------- |
|---|
| 177 | |
|---|
| 178 | PRINT*,'********************************************' |
|---|
| 179 | PRINT*,'WARNING!!! Ancienne discretisation verticale' |
|---|
| 180 | PRINT*,'********************************************' |
|---|
| 181 | stop ! interdit sur MARS |
|---|
| 182 | h=7. |
|---|
| 183 | snorm = 0. |
|---|
| 184 | DO l = 1, llm |
|---|
| 185 | x = 2.*asin(1.) * (FLOAT(l)-0.5) / float(llm+1) |
|---|
| 186 | dsig(l) = 1.0 + 7.0 * SIN(x)**2 |
|---|
| 187 | snorm = snorm + dsig(l) |
|---|
| 188 | ENDDO |
|---|
| 189 | snorm = 1./snorm |
|---|
| 190 | DO l = 1, llm |
|---|
| 191 | dsig(l) = dsig(l)*snorm |
|---|
| 192 | ENDDO |
|---|
| 193 | sig(llm+1) = 0. |
|---|
| 194 | DO l = llm, 1, -1 |
|---|
| 195 | sig(l) = sig(l+1) + dsig(l) |
|---|
| 196 | ENDDO |
|---|
| 197 | |
|---|
| 198 | ENDIF |
|---|
| 199 | c----------------------------------------------------------------------- |
|---|
| 200 | |
|---|
| 201 | DO l=1,llm |
|---|
| 202 | nivsigs(l) = FLOAT(l) |
|---|
| 203 | ENDDO |
|---|
| 204 | |
|---|
| 205 | DO l=1,llmp1 |
|---|
| 206 | nivsig(l)= FLOAT(l) |
|---|
| 207 | ENDDO |
|---|
| 208 | |
|---|
| 209 | c On ne recalcule s que dans les cas "classique" |
|---|
| 210 | c (esasig.def, sigma.def, ou ancienne discretisation sans fichier) |
|---|
| 211 | IF( (ierr1.eq.0) .or. (ierr2.eq.0) |
|---|
| 212 | & .or. ((ierr3.ne.0).and.(ierr4.ne.0)) ) then |
|---|
| 213 | quoi = 1. + 2.* kappa |
|---|
| 214 | s( llm ) = 1. |
|---|
| 215 | s(llm-1) = quoi |
|---|
| 216 | IF( llm.gt.2 ) THEN |
|---|
| 217 | DO ll = 2, llm-1 |
|---|
| 218 | l = llm+1 - ll |
|---|
| 219 | quand = sig(l+1)/ sig(l) |
|---|
| 220 | s(l-1) = quoi * (1.-quand) * s(l) + quand * s(l+1) |
|---|
| 221 | ENDDO |
|---|
| 222 | END IF |
|---|
| 223 | c |
|---|
| 224 | snorm=(1.-.5*sig(2)+kappa*(1.-sig(2)))*s(1)+.5*sig(2)*s(2) |
|---|
| 225 | DO l = 1, llm |
|---|
| 226 | s(l) = s(l)/ snorm |
|---|
| 227 | ENDDO |
|---|
| 228 | END IF |
|---|
| 229 | |
|---|
| 230 | c |
|---|
| 231 | c .... Calculs de ap(l) et de bp(l) .... |
|---|
| 232 | c ......................................... |
|---|
| 233 | c |
|---|
| 234 | c |
|---|
| 235 | c ..... pa et preff sont lus sur les fichiers start par dynetat0 ..... |
|---|
| 236 | c |
|---|
| 237 | |
|---|
| 238 | |
|---|
| 239 | if (hybrid) then |
|---|
| 240 | write(*,*) "*******************************" |
|---|
| 241 | write(*,*) "Systeme en coordonnees hybrides" |
|---|
| 242 | write(*,*) |
|---|
| 243 | c Coordonnees hybrides avec mod |
|---|
| 244 | write(*,*) "sig disvert",sig |
|---|
| 245 | DO l = 1, llm |
|---|
| 246 | call sig_hybrid(sig(l),pa,preff,1.e-6,newsig) |
|---|
| 247 | bp(l) = EXP( 1. -1./( newsig*newsig) ) |
|---|
| 248 | ap(l) = pa * (newsig - bp(l) ) |
|---|
| 249 | enddo |
|---|
| 250 | call sig_hybrid(sig(llmp1),pa,preff,1.e-6,newsig) |
|---|
| 251 | ap(llmp1) = pa * ( newsig - bp(llmp1) ) |
|---|
| 252 | else |
|---|
| 253 | write(*,*) "****************************" |
|---|
| 254 | write(*,*) "Systeme en coordonnees sigma" |
|---|
| 255 | write(*,*) |
|---|
| 256 | c Pour ne pas passer en coordonnees hybrides |
|---|
| 257 | DO l = 1, llm |
|---|
| 258 | ap(l) = 0. |
|---|
| 259 | bp(l) = sig(l) |
|---|
| 260 | ENDDO |
|---|
| 261 | ap(llmp1) = 0. |
|---|
| 262 | endif |
|---|
| 263 | |
|---|
| 264 | bp(llmp1) = 0. |
|---|
| 265 | |
|---|
| 266 | PRINT *,' BP ' |
|---|
| 267 | PRINT *, bp |
|---|
| 268 | PRINT *,' AP ' |
|---|
| 269 | PRINT *, ap |
|---|
| 270 | |
|---|
| 271 | c Calcul au milieu des couches : |
|---|
| 272 | c WARNING : le choix de placer le milieu des couches au niveau de |
|---|
| 273 | c pression intermédiaire est arbitraire et pourrait etre modifié. |
|---|
| 274 | c Le calcul du niveau pour la derniere couche |
|---|
| 275 | c (on met la meme distance (en log pression) entre P(llm) |
|---|
| 276 | c et P(llm -1) qu'entre P(llm-1) et P(llm-2) ) est |
|---|
| 277 | c Specifique. Ce choix est spécifié ici ET dans exner_hyb.F |
|---|
| 278 | |
|---|
| 279 | DO l = 1, llm-1 |
|---|
| 280 | aps(l) = 0.5 *( ap(l) +ap(l+1)) |
|---|
| 281 | bps(l) = 0.5 *( bp(l) +bp(l+1)) |
|---|
| 282 | ENDDO |
|---|
| 283 | |
|---|
| 284 | if (hybrid) then |
|---|
| 285 | aps(llm) = ap(llm-1)**2 / ap(llm-2) |
|---|
| 286 | bps(llm) = 0.5*(bp(llm) + bp(llm+1)) |
|---|
| 287 | else |
|---|
| 288 | bps(llm) = bp(llm-1)**2 / bp(llm-2) |
|---|
| 289 | aps(llm) = 0. |
|---|
| 290 | end if |
|---|
| 291 | |
|---|
| 292 | PRINT *,' BPs ' |
|---|
| 293 | PRINT *, bps |
|---|
| 294 | PRINT *,' APs' |
|---|
| 295 | PRINT *, aps |
|---|
| 296 | |
|---|
| 297 | DO l = 1, llm |
|---|
| 298 | presnivs(l) = aps(l)+bps(l)*preff |
|---|
| 299 | pseudoalt(l) = -10.*log(presnivs(l)/preff) |
|---|
| 300 | ENDDO |
|---|
| 301 | |
|---|
| 302 | PRINT *,' PRESNIVS' |
|---|
| 303 | PRINT *,presnivs |
|---|
| 304 | PRINT *,'Pseudo altitude des Presnivs : ' |
|---|
| 305 | PRINT *,pseudoalt |
|---|
| 306 | |
|---|
| 307 | RETURN |
|---|
| 308 | END |
|---|
| 309 | |
|---|
| 310 | c ************************************************************ |
|---|
| 311 | subroutine sig_hybrid(sig,pa,preff,xacc,newsig) |
|---|
| 312 | c ---------------------------------------------- |
|---|
| 313 | c Subroutine utilisee pour calculer des valeurs de sigma modifie |
|---|
| 314 | c pour conserver les coordonnees verticales decrites dans |
|---|
| 315 | c esasig.def/z2sig.def lors du passage en coordonnees hybrides |
|---|
| 316 | c F. Forget 2002 |
|---|
| 317 | c ---------------------------------------------- |
|---|
| 318 | implicit none |
|---|
| 319 | real x1, x2, xacc, sig,pa,preff, newsig, F |
|---|
| 320 | integer j |
|---|
| 321 | |
|---|
| 322 | newsig = sig |
|---|
| 323 | x1=0 |
|---|
| 324 | x2=1 |
|---|
| 325 | if ((sig.ne.0).and.(sig.ne.1)) then |
|---|
| 326 | DO J=1,9999 ! nombre d''iteration max |
|---|
| 327 | F=(1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig -sig |
|---|
| 328 | if (F.gt.0) then |
|---|
| 329 | X2 = newsig |
|---|
| 330 | newsig=(X1+newsig)*0.5 |
|---|
| 331 | else |
|---|
| 332 | X1 = newsig |
|---|
| 333 | newsig=(X2+newsig)*0.5 |
|---|
| 334 | end if |
|---|
| 335 | c write(0,*) J, ' newsig =', newsig, ' F= ', F |
|---|
| 336 | |
|---|
| 337 | IF(X2-X1.LT.XACC) RETURN |
|---|
| 338 | END DO |
|---|
| 339 | end if |
|---|
| 340 | Return |
|---|
| 341 | END |
|---|
