| 1 | ! |
|---|
| 2 | ! $Id: inidissip.F90 1502 2011-03-21 16:07:54Z jghattas $ |
|---|
| 3 | ! |
|---|
| 4 | SUBROUTINE inidissip ( lstardis,nitergdiv,nitergrot,niterh , & |
|---|
| 5 | tetagdiv,tetagrot,tetatemp, vert_prof_dissip) |
|---|
| 6 | !======================================================================= |
|---|
| 7 | ! Initialization for horizontal (lateral) dissipation |
|---|
| 8 | ! - in all cases, there is a multiplicative coefficient which increases |
|---|
| 9 | ! the dissipation in the higher levels of the atmosphere, but there |
|---|
| 10 | ! are different ways of seting the vertical profile of this coefficient |
|---|
| 11 | ! (see code below). |
|---|
| 12 | ! - the call to dissipation, every 'dissip_period' dynamical time step, |
|---|
| 13 | ! can be imposed via 'dissip_period=...' in run.def (or via the |
|---|
| 14 | ! 'idissip=...' flag, but this flag should become obsolete, and is |
|---|
| 15 | ! overridden by the 'dissip_period' flag). Note that setting |
|---|
| 16 | ! dissip_period=0 has the special meaning of requesting an "optimal" |
|---|
| 17 | ! value for "dissip_period" (then taken as the largest possible value) |
|---|
| 18 | ! - the three characteristic time scales (relative to the smallest |
|---|
| 19 | ! longitudinal grid mesh size), which are privided in run.def, which |
|---|
| 20 | ! are used for the dissipations steps are: |
|---|
| 21 | ! tetagdiv : time scale for the gradient of the divergence of velocities |
|---|
| 22 | ! tetagrot : time scale for the curl of the curl of velocities |
|---|
| 23 | ! tetatemp : time scale for the laplacian of the potential temperature |
|---|
| 24 | !======================================================================= |
|---|
| 25 | |
|---|
| 26 | USE control_mod, only : dissip_period,iperiod,planet_type |
|---|
| 27 | |
|---|
| 28 | IMPLICIT NONE |
|---|
| 29 | include "dimensions.h" |
|---|
| 30 | include "paramet.h" |
|---|
| 31 | include "comdissipn.h" |
|---|
| 32 | include "comconst.h" |
|---|
| 33 | include "comvert.h" |
|---|
| 34 | include "logic.h" |
|---|
| 35 | include "iniprint.h" |
|---|
| 36 | |
|---|
| 37 | LOGICAL,INTENT(in) :: lstardis |
|---|
| 38 | INTEGER,INTENT(in) :: nitergdiv,nitergrot,niterh |
|---|
| 39 | REAL,INTENT(in) :: tetagdiv,tetagrot,tetatemp |
|---|
| 40 | |
|---|
| 41 | integer, INTENT(in):: vert_prof_dissip ! Vertical profile of horizontal dissipation |
|---|
| 42 | ! For the Earth model: |
|---|
| 43 | ! Allowed values: |
|---|
| 44 | ! 0: rational fraction, function of pressure |
|---|
| 45 | ! 1: tanh of altitude |
|---|
| 46 | ! For planets: |
|---|
| 47 | ! 0: use fac_mid (read from run.def) |
|---|
| 48 | ! 1: use fac_mid, fac_up, startalt, delta (hard coded in inidissip.F90) |
|---|
| 49 | ! Local variables: |
|---|
| 50 | REAL fact,zvert(llm),zz |
|---|
| 51 | REAL zh(ip1jmp1),zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1) |
|---|
| 52 | real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1,llm) |
|---|
| 53 | REAL ullm,vllm,umin,vmin,zhmin,zhmax |
|---|
| 54 | REAL zllm |
|---|
| 55 | |
|---|
| 56 | INTEGER l,ij,idum,ii |
|---|
| 57 | REAL tetamin |
|---|
| 58 | REAL pseudoz |
|---|
| 59 | REAL Pup |
|---|
| 60 | character (len=80) :: abort_message |
|---|
| 61 | |
|---|
| 62 | REAL ran1 |
|---|
| 63 | logical,save :: firstcall=.true. |
|---|
| 64 | real,save :: fac_mid,fac_up,startalt,delta,middle |
|---|
| 65 | |
|---|
| 66 | if (firstcall) then |
|---|
| 67 | firstcall=.false. |
|---|
| 68 | if ((planet_type.ne."earth").and.(vert_prof_dissip.eq.1)) then |
|---|
| 69 | ! initialize values for dissipation variation along the vertical (Mars) |
|---|
| 70 | fac_mid=3 ! coefficient for lower/middle atmosphere |
|---|
| 71 | fac_up=30 ! coefficient for upper atmosphere |
|---|
| 72 | startalt=70. ! altitude (in km) for the transition from middle to upper atm. |
|---|
| 73 | delta=30.! Size (in km) of the transition region between middle/upper atm. |
|---|
| 74 | |
|---|
| 75 | middle=startalt+delta/2 |
|---|
| 76 | write(lunout,*)"inidissip: multiplicative factors in altitude:", & |
|---|
| 77 | " fac_mid=",fac_mid," fac_up=",fac_up |
|---|
| 78 | write(lunout,*)" transition mid/up : startalt (km) =",startalt, & |
|---|
| 79 | " delta (km) =",delta |
|---|
| 80 | endif |
|---|
| 81 | endif !of if firstcall |
|---|
| 82 | |
|---|
| 83 | !----------------------------------------------------------------------- |
|---|
| 84 | ! |
|---|
| 85 | ! calcul des valeurs propres des operateurs par methode iterrative: |
|---|
| 86 | ! ----------------------------------------------------------------- |
|---|
| 87 | |
|---|
| 88 | crot = -1. |
|---|
| 89 | cdivu = -1. |
|---|
| 90 | cdivh = -1. |
|---|
| 91 | |
|---|
| 92 | ! calcul de la valeur propre de divgrad: |
|---|
| 93 | ! -------------------------------------- |
|---|
| 94 | idum = 0 |
|---|
| 95 | DO l = 1, llm |
|---|
| 96 | DO ij = 1, ip1jmp1 |
|---|
| 97 | deltap(ij,l) = 1. |
|---|
| 98 | ENDDO |
|---|
| 99 | ENDDO |
|---|
| 100 | |
|---|
| 101 | idum = -1 |
|---|
| 102 | zh(1) = RAN1(idum)-.5 |
|---|
| 103 | idum = 0 |
|---|
| 104 | DO ij = 2, ip1jmp1 |
|---|
| 105 | zh(ij) = RAN1(idum) -.5 |
|---|
| 106 | ENDDO |
|---|
| 107 | |
|---|
| 108 | CALL filtreg (zh,jjp1,1,2,1,.TRUE.,1) |
|---|
| 109 | |
|---|
| 110 | CALL minmax(iip1*jjp1,zh,zhmin,zhmax ) |
|---|
| 111 | |
|---|
| 112 | IF ( zhmin .GE. zhmax ) THEN |
|---|
| 113 | write(lunout,*)' Inidissip zh min max ',zhmin,zhmax |
|---|
| 114 | abort_message='probleme generateur alleatoire dans inidissip' |
|---|
| 115 | call abort_gcm('inidissip',abort_message,1) |
|---|
| 116 | ENDIF |
|---|
| 117 | |
|---|
| 118 | zllm = ABS( zhmax ) |
|---|
| 119 | DO l = 1,50 |
|---|
| 120 | IF(lstardis) THEN |
|---|
| 121 | CALL divgrad2(1,zh,deltap,niterh,divgra) |
|---|
| 122 | ELSE |
|---|
| 123 | CALL divgrad (1,zh,niterh,divgra) |
|---|
| 124 | ENDIF |
|---|
| 125 | |
|---|
| 126 | zllm = ABS(maxval(divgra)) |
|---|
| 127 | zh = divgra / zllm |
|---|
| 128 | ENDDO |
|---|
| 129 | |
|---|
| 130 | IF(lstardis) THEN |
|---|
| 131 | cdivh = 1./ zllm |
|---|
| 132 | ELSE |
|---|
| 133 | cdivh = zllm ** ( -1./niterh ) |
|---|
| 134 | ENDIF |
|---|
| 135 | |
|---|
| 136 | ! calcul des valeurs propres de gradiv (ii =1) et nxgrarot(ii=2) |
|---|
| 137 | ! ----------------------------------------------------------------- |
|---|
| 138 | write(lunout,*)'inidissip: calcul des valeurs propres' |
|---|
| 139 | |
|---|
| 140 | DO ii = 1, 2 |
|---|
| 141 | ! |
|---|
| 142 | DO ij = 1, ip1jmp1 |
|---|
| 143 | zu(ij) = RAN1(idum) -.5 |
|---|
| 144 | ENDDO |
|---|
| 145 | CALL filtreg (zu,jjp1,1,2,1,.TRUE.,1) |
|---|
| 146 | DO ij = 1, ip1jm |
|---|
| 147 | zv(ij) = RAN1(idum) -.5 |
|---|
| 148 | ENDDO |
|---|
| 149 | CALL filtreg (zv,jjm,1,2,1,.FALSE.,1) |
|---|
| 150 | |
|---|
| 151 | CALL minmax(iip1*jjp1,zu,umin,ullm ) |
|---|
| 152 | CALL minmax(iip1*jjm, zv,vmin,vllm ) |
|---|
| 153 | |
|---|
| 154 | ullm = ABS ( ullm ) |
|---|
| 155 | vllm = ABS ( vllm ) |
|---|
| 156 | |
|---|
| 157 | DO l = 1, 50 |
|---|
| 158 | IF(ii.EQ.1) THEN |
|---|
| 159 | !cccc CALL covcont( 1,zu,zv,zu,zv ) |
|---|
| 160 | IF(lstardis) THEN |
|---|
| 161 | CALL gradiv2( 1,zu,zv,nitergdiv,gx,gy ) |
|---|
| 162 | ELSE |
|---|
| 163 | CALL gradiv ( 1,zu,zv,nitergdiv,gx,gy ) |
|---|
| 164 | ENDIF |
|---|
| 165 | ELSE |
|---|
| 166 | IF(lstardis) THEN |
|---|
| 167 | CALL nxgraro2( 1,zu,zv,nitergrot,gx,gy ) |
|---|
| 168 | ELSE |
|---|
| 169 | CALL nxgrarot( 1,zu,zv,nitergrot,gx,gy ) |
|---|
| 170 | ENDIF |
|---|
| 171 | ENDIF |
|---|
| 172 | |
|---|
| 173 | zllm = max(abs(maxval(gx)), abs(maxval(gy))) |
|---|
| 174 | zu = gx / zllm |
|---|
| 175 | zv = gy / zllm |
|---|
| 176 | end DO |
|---|
| 177 | |
|---|
| 178 | IF ( ii.EQ.1 ) THEN |
|---|
| 179 | IF(lstardis) THEN |
|---|
| 180 | cdivu = 1./zllm |
|---|
| 181 | ELSE |
|---|
| 182 | cdivu = zllm **( -1./nitergdiv ) |
|---|
| 183 | ENDIF |
|---|
| 184 | ELSE |
|---|
| 185 | IF(lstardis) THEN |
|---|
| 186 | crot = 1./ zllm |
|---|
| 187 | ELSE |
|---|
| 188 | crot = zllm **( -1./nitergrot ) |
|---|
| 189 | ENDIF |
|---|
| 190 | ENDIF |
|---|
| 191 | |
|---|
| 192 | end DO |
|---|
| 193 | |
|---|
| 194 | ! petit test pour les operateurs non star: |
|---|
| 195 | ! ---------------------------------------- |
|---|
| 196 | |
|---|
| 197 | ! IF(.NOT.lstardis) THEN |
|---|
| 198 | fact = rad*24./REAL(jjm) |
|---|
| 199 | fact = fact*fact |
|---|
| 200 | write(lunout,*)'inidissip: coef u ', fact/cdivu, 1./cdivu |
|---|
| 201 | write(lunout,*)'inidissip: coef r ', fact/crot , 1./crot |
|---|
| 202 | write(lunout,*)'inidissip: coef h ', fact/cdivh, 1./cdivh |
|---|
| 203 | ! ENDIF |
|---|
| 204 | |
|---|
| 205 | !----------------------------------------------------------------------- |
|---|
| 206 | ! variation verticale du coefficient de dissipation: |
|---|
| 207 | ! -------------------------------------------------- |
|---|
| 208 | |
|---|
| 209 | if (planet_type.eq."earth") then |
|---|
| 210 | |
|---|
| 211 | if (vert_prof_dissip == 1) then |
|---|
| 212 | do l=1,llm |
|---|
| 213 | pseudoz=8.*log(preff/presnivs(l)) |
|---|
| 214 | zvert(l)=1+ & |
|---|
| 215 | (tanh((pseudoz-dissip_zref)/dissip_deltaz)+1.)/2. & |
|---|
| 216 | *(dissip_factz-1.) |
|---|
| 217 | enddo |
|---|
| 218 | else |
|---|
| 219 | DO l=1,llm |
|---|
| 220 | zvert(l)=1. |
|---|
| 221 | ENDDO |
|---|
| 222 | fact=2. |
|---|
| 223 | DO l = 1, llm |
|---|
| 224 | zz = 1. - preff/presnivs(l) |
|---|
| 225 | zvert(l)= fact -( fact-1.)/( 1.+zz*zz ) |
|---|
| 226 | ENDDO |
|---|
| 227 | endif ! of if (vert_prof_dissip == 1) |
|---|
| 228 | |
|---|
| 229 | else ! other planets |
|---|
| 230 | |
|---|
| 231 | if (vert_prof_dissip == 0) then |
|---|
| 232 | ! First step: going from 1 to dissip_fac_mid (in gcm.def) |
|---|
| 233 | !============ |
|---|
| 234 | DO l=1,llm |
|---|
| 235 | zz = 1. - preff/presnivs(l) |
|---|
| 236 | zvert(l)= dissip_fac_mid -( dissip_fac_mid-1.)/( 1.+zz*zz ) |
|---|
| 237 | ENDDO |
|---|
| 238 | |
|---|
| 239 | write(lunout,*) 'Dissipation : ' |
|---|
| 240 | write(lunout,*) 'Multiplication de la dissipation en altitude :' |
|---|
| 241 | write(lunout,*) ' dissip_fac_mid =', dissip_fac_mid |
|---|
| 242 | |
|---|
| 243 | ! Second step if ok_strato: from dissip_fac_mid to dissip_fac_up (in gcm.def) |
|---|
| 244 | !========================== |
|---|
| 245 | ! Utilisation de la fonction tangente hyperbolique pour augmenter |
|---|
| 246 | ! arbitrairement la dissipation et donc la stabilite du modele a |
|---|
| 247 | ! partir d'une certaine altitude. |
|---|
| 248 | |
|---|
| 249 | ! Le facteur multiplicatif de basse atmosphere etant deja pris |
|---|
| 250 | ! en compte, il faut diviser le facteur multiplicatif de haute |
|---|
| 251 | ! atmosphere par celui-ci. |
|---|
| 252 | |
|---|
| 253 | if (ok_strato) then |
|---|
| 254 | |
|---|
| 255 | Pup = dissip_pupstart*exp(-0.5*dissip_deltaz/dissip_hdelta) |
|---|
| 256 | do l=1,llm |
|---|
| 257 | zvert(l)= zvert(l)*(1.0+( (dissip_fac_up/dissip_fac_mid-1) & |
|---|
| 258 | *(1-(0.5*(1+tanh(-6./dissip_deltaz* & |
|---|
| 259 | (-dissip_hdelta*log(presnivs(l)/Pup)) )))) )) |
|---|
| 260 | enddo |
|---|
| 261 | |
|---|
| 262 | write(*,*) ' dissip_fac_up =', dissip_fac_up |
|---|
| 263 | write(*,*) 'Transition mid /up: Pupstart,delta =', & |
|---|
| 264 | dissip_pupstart,'Pa', dissip_deltaz , '(km)' |
|---|
| 265 | |
|---|
| 266 | endif ! of if (ok_strato) |
|---|
| 267 | elseif (vert_prof_dissip==1) then |
|---|
| 268 | DO l=1,llm |
|---|
| 269 | zz = 1. - preff/presnivs(l) |
|---|
| 270 | ! zvert(l)= dissip_fac_mid -( dissip_fac_mid-1.)/( 1.+zz*zz ) |
|---|
| 271 | zvert(l)= fac_mid -( fac_mid-1.)/( 1.+zz*zz ) |
|---|
| 272 | |
|---|
| 273 | zvert(l)= zvert(l)*(1.0+((fac_up/fac_mid-1)* & |
|---|
| 274 | (1-(0.5*(1+tanh(-6./ & |
|---|
| 275 | delta*(scaleheight*(-log(presnivs(l)/preff))-middle))))) & |
|---|
| 276 | )) |
|---|
| 277 | ENDDO |
|---|
| 278 | write(lunout,*) "inidissip: vert_prof_disip=1, scaleheight=",scaleheight |
|---|
| 279 | write(lunout,*) " fac_mid=",fac_mid,", fac_up=",fac_up |
|---|
| 280 | |
|---|
| 281 | else |
|---|
| 282 | write(lunout,*) 'wrong value for vert_prof_dissip:',vert_prof_dissip |
|---|
| 283 | abort_message='wrong value for vert_prof_dissip' |
|---|
| 284 | call abort_gcm('inidissip',abort_message,1) |
|---|
| 285 | endif ! of (vert_prof_dissip == 0) |
|---|
| 286 | endif ! of if (planet_type.eq."earth") |
|---|
| 287 | |
|---|
| 288 | |
|---|
| 289 | write(lunout,*)'inidissip: Time constants for lateral dissipation' |
|---|
| 290 | |
|---|
| 291 | tetamin = 1.e+6 |
|---|
| 292 | |
|---|
| 293 | DO l=1,llm |
|---|
| 294 | tetaudiv(l) = zvert(l)/tetagdiv |
|---|
| 295 | tetaurot(l) = zvert(l)/tetagrot |
|---|
| 296 | tetah(l) = zvert(l)/tetatemp |
|---|
| 297 | |
|---|
| 298 | IF( tetamin.GT. (1./tetaudiv(l)) ) tetamin = 1./ tetaudiv(l) |
|---|
| 299 | IF( tetamin.GT. (1./tetaurot(l)) ) tetamin = 1./ tetaurot(l) |
|---|
| 300 | IF( tetamin.GT. (1./ tetah(l)) ) tetamin = 1./ tetah(l) |
|---|
| 301 | ENDDO |
|---|
| 302 | |
|---|
| 303 | ! If dissip_period=0 calculate value for dissipation period, else keep value read from gcm.def |
|---|
| 304 | IF (dissip_period == 0) THEN |
|---|
| 305 | dissip_period = INT( tetamin/( 2.*dtvr*iperiod) ) * iperiod |
|---|
| 306 | write(lunout,*)'inidissip: tetamin dtvr iperiod dissip_period(intermed) ',tetamin,dtvr,iperiod,dissip_period |
|---|
| 307 | dissip_period = MAX(iperiod,dissip_period) |
|---|
| 308 | END IF |
|---|
| 309 | |
|---|
| 310 | dtdiss = dissip_period * dtvr |
|---|
| 311 | write(lunout,*)'inidissip: dissip_period=',dissip_period,' dtdiss=',dtdiss,' dtvr=',dtvr |
|---|
| 312 | |
|---|
| 313 | write(lunout,*)'pseudoZ(km) zvert dt(tetagdiv) dt(tetagrot) dt(divgrad)' |
|---|
| 314 | DO l = 1,llm |
|---|
| 315 | write(lunout,'(f6.1,x,4(1pe14.7,x))') & |
|---|
| 316 | pseudoalt(l),zvert(l),dtdiss*tetaudiv(l),dtdiss*tetaurot(l),dtdiss*tetah(l) |
|---|
| 317 | ! test if disipation is not too strong (for Explicit Euler time marching) |
|---|
| 318 | if (dtdiss*tetaudiv(l).gt.1.9) then |
|---|
| 319 | write(lunout,*)"STOP : lateral dissipation is too intense and will" |
|---|
| 320 | write(lunout,*)" generate instabilities in the model !" |
|---|
| 321 | write(lunout,*)" You must increase tetagdiv (or increase dissip_period" |
|---|
| 322 | write(lunout,*)" or increase day_stap)" |
|---|
| 323 | endif |
|---|
| 324 | if (dtdiss*tetaurot(l).gt.1.9) then |
|---|
| 325 | write(lunout,*)"STOP : lateral dissipation is too intense and will" |
|---|
| 326 | write(lunout,*)" generate instabilities in the model !" |
|---|
| 327 | write(lunout,*)" You must increase tetaurot (or increase dissip_period" |
|---|
| 328 | write(lunout,*)" or increase day_stap)" |
|---|
| 329 | endif |
|---|
| 330 | if (dtdiss*tetah(l).gt.1.9) then |
|---|
| 331 | write(lunout,*)"STOP : lateral dissipation is too intense and will" |
|---|
| 332 | write(lunout,*)" generate instabilities in the model !" |
|---|
| 333 | write(lunout,*)" You must increase tetah (or increase dissip_period" |
|---|
| 334 | write(lunout,*)" or increase day_stap)" |
|---|
| 335 | endif |
|---|
| 336 | ENDDO ! of DO l=1,llm |
|---|
| 337 | |
|---|
| 338 | END SUBROUTINE inidissip |
|---|
![(please configure the [header_logo] section in trac.ini)](/dynamico/chrome/site/your_project_logo.png){kind=logo}
