Changeset 5202 for LMDZ6/branches/cirrus/libf/dyn3dmem
- Timestamp:
- Sep 20, 2024, 12:32:04 PM (8 weeks ago)
- Location:
- LMDZ6/branches/cirrus
- Files:
-
- 1 deleted
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/cirrus
- Property svn:mergeinfo changed
-
LMDZ6/branches/cirrus/libf/dyn3dmem/check_isotopes_loc.F90
r4399 r5202 24 24 iso_O17, iso_HTO 25 25 LOGICAL, SAVE :: first=.TRUE. 26 LOGICAL, PARAMETER :: tnat1=.TRUE. 26 27 !$OMP THREADPRIVATE(first) 27 28 … … 37 38 iso_O17 = strIdx(isoName,'H217O') 38 39 iso_HTO = strIdx(isoName,'HTO') 39 IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1) 40 if (tnat1) then 41 tnat(:)=1.0 42 else 43 IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1) 44 endif 40 45 !$OMP END MASTER 41 46 !$OMP BARRIER -
LMDZ6/branches/cirrus/libf/dyn3dmem/conf_gcm.F90
r4608 r5202 22 22 USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, & 23 23 ok_guide, ok_limit, ok_strato, purmats, read_start, & 24 ysinus, read_orop 24 ysinus, read_orop, adv_qsat_liq 25 25 USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, & 26 26 alphax,alphay,taux,tauy … … 660 660 type_trac = 'lmdz' 661 661 CALL getin('type_trac',type_trac) 662 663 664 !Config Key = adv_qsat_liq 665 !Config Desc = option for qsat calculation in the dynamics 666 !Config Def = n 667 !Config Help = controls which phase is considered for qsat calculation 668 !Config 669 adv_qsat_liq = .FALSE. 670 CALL getin('adv_qsat_liq',adv_qsat_liq) 662 671 663 672 !Config Key = ok_dynzon … … 736 745 write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave 737 746 write(lunout,*)' ok_dyn_xios = ', ok_dyn_xios 747 write(lunout,*)' adv_qsat_liq = ', adv_qsat_liq 738 748 else 739 749 !Config Key = clon -
LMDZ6/branches/cirrus/libf/dyn3dmem/dynetat0_loc.F90
r4490 r5202 42 42 INTEGER, PARAMETER :: length=100 43 43 INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix 44 REAL :: time, tnat, alpha_ideal, tab_cntrl(length) !--- RUN PARAMS TABLE 44 REAL :: time,tab_cntrl(length) !--- RUN PARAMS TABLE 45 REAL :: tnat, alpha_ideal 45 46 REAL, ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:), ps_glo(:) 46 47 REAL, ALLOCATABLE :: ucov_glo(:,:), q_glo(:,:), phis_glo(:) 47 48 REAL, ALLOCATABLE :: teta_glo(:,:) 48 49 LOGICAL :: lSkip, ll 50 LOGICAL,PARAMETER :: tnat1=.TRUE. 49 51 !------------------------------------------------------------------------------- 50 52 modname="dynetat0_loc" … … 179 181 iqParent = tracers(iq)%iqParent 180 182 IF(tracers(iq)%iso_iZone == 0) THEN 181 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 183 if (tnat1) then 184 tnat=1.0 185 alpha_ideal=1.0 186 write(*,*) 'attention dans dynetat0: les alpha_ideal sont a 1' 187 else 188 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 182 189 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 190 endif 183 191 CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname) 184 192 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.) … … 193 201 ! remplacant 1 par izone_init dans la ligne qui suit. 194 202 IF(tracers(iq)%iso_iZone == 1) THEN 195 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))203 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase)) 196 204 ELSE 197 205 q(ijb_u:ije_u,:,iq) = 0. -
LMDZ6/branches/cirrus/libf/dyn3dmem/dynredem_mod.F90
r2299 r5202 7 7 PRIVATE 8 8 PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err 9 PUBLIC :: cre_var, get_var1,put_var, fil, modname, msg9 PUBLIC :: cre_var, put_var, fil, modname, msg 10 10 CHARACTER(LEN=256), SAVE :: fil, modname 11 11 INTEGER, SAVE :: nvarid -
LMDZ6/branches/cirrus/libf/dyn3dmem/gcm.F90
r4619 r5202 480 480 !$OMP COPYIN(saison,ecripar,fxyhypb,ysinus,read_start,ok_guide) & 481 481 !$OMP COPYIN(ok_strato,ok_gradsfile,ok_limit,ok_etat0) & 482 !$OMP COPYIN(iflag_phys,iflag_trac )482 !$OMP COPYIN(iflag_phys,iflag_trac,adv_qsat_liq) 483 483 CALL leapfrog_loc(ucov,vcov,teta,ps,masse,phis,q,time_0) 484 484 !$OMP END PARALLEL -
LMDZ6/branches/cirrus/libf/dyn3dmem/iniacademic_loc.F90
r4419 r5202 85 85 86 86 REAL zdtvr, tnat, alpha_ideal 87 LOGICAL,PARAMETER :: tnat1=.true. 87 88 88 89 character(len=*),parameter :: modname="iniacademic" … … 323 324 iqParent = tracers(iq)%iqParent 324 325 IF(tracers(iq)%iso_iZone == 0) THEN 325 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 326 if (tnat1) then 327 tnat=1.0 328 alpha_ideal=1.0 329 write(*,*) 'Attention dans iniacademic: alpha_ideal=1' 330 else 331 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) & 326 332 CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1) 333 endif 327 334 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.) 328 ELSE 329 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase)) 330 END IF 335 ELSE !IF(tracers(iq)%iso_iZone == 0) THEN 336 IF(tracers(iq)%iso_iZone == 1) THEN ! a verifier. 337 ! correction le 14 mai 2024 pour que tous les traceurs soient de la couleur 1. 338 ! Sinon, on va avoir des porblèmes de conservation de masse de traceurs. 339 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase)) 340 else !IF(tracers(iq)%iso_iZone == 1) THEN 341 q(ijb_u:ije_u,:,iq) = 0.0 342 endif !IF(tracers(iq)%iso_iZone == 1) THEN 343 END IF !IF(tracers(iq)%iso_iZone == 0) THEN 331 344 enddo 332 345 else -
LMDZ6/branches/cirrus/libf/dyn3dmem/logic_mod.F90
r2665 r5202 30 30 LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise) 31 31 ! (only used if disvert_type==2) 32 LOGICAL adv_qsat_liq ! true if qsat is calculated alwats wrt liquid for 33 ! adapted Van Leer advection scheme 32 34 INTEGER iflag_phys ! type of physics to call: 0 none, 1: phy*** package, 33 35 ! 2: Held & Suarez, 101-200: aquaplanets & terraplanets … … 37 39 !$OMP apdiss,apdelq,saison,ecripar,fxyhypb,ysinus, & 38 40 !$OMP read_start,ok_guide,ok_strato,ok_gradsfile, & 39 !$OMP ok_limit,ok_etat0,hybrid )41 !$OMP ok_limit,ok_etat0,hybrid, adv_qsat_liq) 40 42 !$OMP THREADPRIVATE(iflag_phys,iflag_trac) 41 43 -
LMDZ6/branches/cirrus/libf/dyn3dmem/qminimum_loc.F
r4469 r5202 31 31 c ................................................................. 32 32 c 33 cDC iq_val and iq_liq are usable for q only, NOT for q_follow 34 c and zx_defau_diag (crash if iq_val/liq==3) => vapor/liquid 35 c water at hardcoded indices 1/2 in these variables 33 36 INTEGER i, k, iq 34 37 REAL zx_defau, zx_abc, zx_pump(ijb_u:ije_u), pompe … … 49 52 INTEGER ixt 50 53 INTEGER iso_verif_noNaN_nostop 51 c52 c Quand l'eau liquide est trop petite (ou negative), on prend53 c l'eau vapeur de la meme couche et la convertit en eau liquide54 c (sans changer la temperature !)55 c56 54 57 55 c$OMP BARRIER … … 63 61 first = .FALSE. 64 62 END IF 63 c 64 c Quand l'eau liquide est trop petite (ou negative), on prend 65 c l'eau vapeur de la meme couche et la convertit en eau liquide 66 c (sans changer la temperature !) 67 c 68 65 69 call check_isotopes(q,ij_begin,ij_end,'qminimum 52') 66 70 … … 73 77 zx_defau_diag(i,k,1)=0.0 74 78 zx_defau_diag(i,k,2)=0.0 75 q_follow(i,k,1)=q(i,k, 1)76 q_follow(i,k,2)=q(i,k, 2)79 q_follow(i,k,1)=q(i,k,iq_vap) 80 q_follow(i,k,2)=q(i,k,iq_liq) 77 81 ENDDO 78 82 c$OMP END DO NOWAIT … … 80 84 81 85 !write(lunout,*) 'qminimum 57' 82 DO 1000k = 1, llm86 DO k = 1, llm 83 87 c$OMP DO SCHEDULE(STATIC) 84 DO 1040i = ijb, ije85 86 87 if (niso > 0) zx_defau_diag(i,k,iq_liq)=AMAX188 DO i = ijb, ije 89 if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then 90 91 if (niso > 0) zx_defau_diag(i,k,2)=AMAX1 88 92 : ( seuil_liq - q(i,k,iq_liq), 0.0 ) 89 93 90 91 92 93 1040 CONTINUE94 c$OMP END DO NOWAIT 95 1000 CONTINUE94 q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq 95 q(i,k,iq_liq) = seuil_liq 96 endif 97 END DO 98 c$OMP END DO NOWAIT 99 END DO 96 100 97 101 c … … 100 104 c 101 105 !write(lunout,*) 'qminimum 81' 102 iq = iq_vap103 c104 106 DO k = llm, 2, -1 105 107 ccc zx_abc = dpres(k) / dpres(k-1) 106 108 c$OMP DO SCHEDULE(STATIC) 107 DO i = ijb, ije108 109 if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then110 111 if (niso > 0) 112 & zx_defau_diag(i,k,iq)=AMAX1( seuil_vap - q(i,k,iq), 0.0 )113 114 q(i,k-1,iq ) = q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *115 & deltap(i,k) /deltap(i,k-1)116 q(i,k,iq ) = seuil_vap117 118 endif119 ENDDO109 DO i = ijb, ije 110 111 if ( seuil_vap - q(i,k,iq_vap) .gt. 0.d0 ) then 112 113 if (niso > 0) zx_defau_diag(i,k,1) 114 & = AMAX1( seuil_vap - q(i,k,iq_vap), 0.0 ) 115 116 q(i,k-1,iq_vap) = q(i,k-1,iq_vap) - (seuil_vap 117 & -q(i,k,iq_vap)) * deltap(i,k)/deltap(i,k-1) 118 q(i,k,iq_vap) = seuil_vap 119 120 endif 121 ENDDO 120 122 c$OMP END DO NOWAIT 121 123 ENDDO … … 129 131 c$OMP DO SCHEDULE(STATIC) 130 132 DO i = ijb, ije 131 zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq ) )132 q(i,1,iq ) = AMAX1( q(i,1,iq), seuil_vap )133 zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq_vap) ) 134 q(i,1,iq_vap) = AMAX1( q(i,1,iq_vap), seuil_vap ) 133 135 IF (zx_pump(i) > 0.0) THEN 134 136 nb_pump = nb_pump+1 … … 165 167 DO i = ijb, ije 166 168 if (zx_pump(i).gt.0.0) then 167 q_follow(i,1, iq_vap)=q_follow(i,1,iq_vap)+zx_pump(i)169 q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i) 168 170 endif !if (zx_pump(i).gt.0.0) then 169 171 enddo !DO i = ijb, ije … … 175 177 c$OMP DO SCHEDULE(STATIC) 176 178 DO i = ijb, ije 177 if (zx_defau_diag(i,k, iq_vap).gt.0.0) then179 if (zx_defau_diag(i,k,1).gt.0.0) then 178 180 ! on ajoute la vapeur en k 179 ! write(lunout,*) 'i,k,q_follow(i,k-1,i q_vap)=',180 ! : i,k,q_follow(i,k-1, iq_vap)181 if (q_follow(i,k-1, iq_vap).lt.min_qParent) then181 ! write(lunout,*) 'i,k,q_follow(i,k-1,ivap)=', 182 ! : i,k,q_follow(i,k-1,1) 183 if (q_follow(i,k-1,1).lt.min_qParent) then 182 184 write(lunout,*) 'tmp qmin: on stoppe' 183 185 write(lunout,*) 'zx_pump(i)=',zx_pump(i) 184 write(lunout,*) 'q_follow(i,:,i q_vap)=',185 : q_follow(i,:, iq_vap)186 write(lunout,*) 'q_follow(i,:,ivap)=', 187 : q_follow(i,:,1) 186 188 write(lunout,*) 'k=',k 187 189 call abort_gcm("qminimum","not enough vapor",1) … … 189 191 do ixt=1,ntiso 190 192 ! write(lunout,*) 'qmin 168: ixt=',ixt 191 ! write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap) =',193 ! write(lunout,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=', 192 194 ! : q(i,k,iqIsoPha(ixt,iq_vap)) 193 ! write(lunout,*) 'zx_defau_diag(i,k,i q_vap)=',194 ! : zx_defau_diag(i,k, iq_vap)195 ! write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap) =',195 ! write(lunout,*) 'zx_defau_diag(i,k,ivap)=', 196 ! : zx_defau_diag(i,k,1) 197 ! write(lunout,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=', 196 198 ! : q(i,k-1,iqIsoPha(ixt,iq_vap)) 197 199 198 200 q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) 199 : +zx_defau_diag(i,k, iq_vap)200 : *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1, iq_vap)201 : +zx_defau_diag(i,k,1) 202 : *q(i,k-1,iqIsoPha(ixt,iq_vap))/q_follow(i,k-1,1) 201 203 202 204 if (isoCheck) then … … 204 206 : 'qminimum 155').eq.1) then 205 207 write(*,*) 'i,k,ixt=',i,k,ixt 206 write(*,*) 'q_follow(i,k-1,i q_vap)=',207 : q_follow(i,k-1, iq_vap)208 write(*,*) 'q_follow(i,k-1,ivap)=', 209 : q_follow(i,k-1,1) 208 210 write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=', 209 211 : q(i,k,iqIsoPha(ixt,iq_vap)) 210 write(*,*) 'zx_defau_diag(i,k,i q_vap)=',211 : zx_defau_diag(i,k, iq_vap)212 write(*,*) 'zx_defau_diag(i,k,ivap)=', 213 : zx_defau_diag(i,k,1) 212 214 write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=', 213 215 : q(i,k-1,iqIsoPha(ixt,iq_vap)) … … 219 221 q(i,k-1,iqIsoPha(ixt,iq_vap)) = 220 222 : q(i,k-1,iqIsoPha(ixt,iq_vap)) 221 : -zx_defau_diag(i,k, iq_vap)223 : -zx_defau_diag(i,k,1) 222 224 : *deltap(i,k)/deltap(i,k-1) 223 225 : *q(i,k-1,iqIsoPha(ixt,iq_vap)) 224 : /q_follow(i,k-1, iq_vap)226 : /q_follow(i,k-1,1) 225 227 226 228 if (isoCheck) then … … 229 231 : 'qminimum 175').eq.1) then 230 232 write(*,*) 'k,i,ixt=',k,i,ixt 231 write(*,*) 'q_follow(i,k-1,i q_vap)=',232 : q_follow(i,k-1, iq_vap)233 write(*,*) 'q_follow(i,k-1,ivap)=', 234 : q_follow(i,k-1,1) 233 235 write(*,*) 'q(i,k,iqIsoPha(ixt,iq_vap))=', 234 236 : q(i,k,iqIsoPha(ixt,iq_vap)) 235 write(*,*) 'zx_defau_diag(i,k,i q_vap)=',236 : zx_defau_diag(i,k, iq_vap)237 write(*,*) 'zx_defau_diag(i,k,ivap)=', 238 : zx_defau_diag(i,k,1) 237 239 write(*,*) 'q(i,k-1,iqIsoPha(ixt,iq_vap))=', 238 240 : q(i,k-1,iqIsoPha(ixt,iq_vap)) … … 242 244 243 245 enddo !do ixt=1,niso 244 q_follow(i,k, iq_vap)= q_follow(i,k,iq_vap)245 : +zx_defau_diag(i,k, iq_vap)246 q_follow(i,k-1, iq_vap)= q_follow(i,k-1,iq_vap)247 : -zx_defau_diag(i,k, iq_vap)246 q_follow(i,k,1)= q_follow(i,k,1) 247 : +zx_defau_diag(i,k,1) 248 q_follow(i,k-1,1)= q_follow(i,k-1,1) 249 : -zx_defau_diag(i,k,1) 248 250 : *deltap(i,k)/deltap(i,k-1) 249 endif !if (zx_defau_diag(i,k, iq_vap).gt.0.0) then251 endif !if (zx_defau_diag(i,k,1).gt.0.0) then 250 252 enddo !DO i = 1, ip1jmp1 251 253 c$OMP END DO NOWAIT … … 260 262 c$OMP DO SCHEDULE(STATIC) 261 263 DO i = ijb, ije 262 if (zx_defau_diag(i,k, iq_liq).gt.0.0) then264 if (zx_defau_diag(i,k,2).gt.0.0) then 263 265 264 266 ! on ajoute eau liquide en k en k 265 267 do ixt=1,ntiso 266 268 q(i,k,iqIsoPha(ixt,iq_liq))=q(i,k,iqIsoPha(ixt,iq_liq)) 267 : +zx_defau_diag(i,k, iq_liq)268 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k, iq_vap)269 : +zx_defau_diag(i,k,2) 270 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1) 269 271 ! et on la retranche à la vapeur en k 270 272 q(i,k,iqIsoPha(ixt,iq_vap))=q(i,k,iqIsoPha(ixt,iq_vap)) 271 : -zx_defau_diag(i,k, iq_liq)272 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k, iq_vap)273 : -zx_defau_diag(i,k,2) 274 : *q(i,k,iqIsoPha(ixt,iq_vap))/q_follow(i,k,1) 273 275 enddo !do ixt=1,niso 274 q_follow(i,k, iq_liq)= q_follow(i,k,iq_liq)275 : +zx_defau_diag(i,k, iq_liq)276 q_follow(i,k, iq_vap)= q_follow(i,k,iq_vap)277 : -zx_defau_diag(i,k, iq_liq)278 endif !if (zx_defau_diag(i,k, iq_vap).gt.0.0) then276 q_follow(i,k,2)= q_follow(i,k,2) 277 : +zx_defau_diag(i,k,2) 278 q_follow(i,k,1)= q_follow(i,k,1) 279 : -zx_defau_diag(i,k,2) 280 endif !if (zx_defau_diag(i,k,1).gt.0.0) then 279 281 enddo !DO i = ijb, ije 280 282 c$OMP END DO NOWAIT -
LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltgen_loc.F
r4469 r5202 10 10 c 11 11 c ******************************************************************** 12 c S hema d'advection " pseudo amont " .12 c Schema d'advection " pseudo amont " . 13 13 c + test sur humidite specifique: Q advecte< Qsat aval 14 14 c (F. Codron, 10/99) … … 32 32 USE vlspltgen_mod 33 33 USE comconst_mod, ONLY: cpp 34 USE logic_mod, ONLY: adv_qsat_liq 34 35 IMPLICIT NONE 35 36 … … 108 109 ENDDO 109 110 DO ij = ijb, ije 110 zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) ) 111 IF (adv_qsat_liq) THEN 112 zdelta = 0. 113 ELSE 114 zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) ) 115 ENDIF 111 116 play = 0.5*(p(ij,l)+p(ij,l+1)) 112 117 qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play ) -
LMDZ6/branches/cirrus/libf/dyn3dmem/vlspltqs_loc.F
r4469 r5202 806 806 IF (pole_sud) THEN 807 807 808 convps = -SSUM(iim,qbyv(ip1jm-iim,l,iq), iq,1)/apols808 convps = -SSUM(iim,qbyv(ip1jm-iim,l,iq),1)/apols 809 809 convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols 810 810 DO ij = ip1jm+1,ip1jmp1
Note: See TracChangeset
for help on using the changeset viewer.