Changeset 5434
- Timestamp:
- Dec 20, 2024, 11:48:05 AM (12 hours ago)
- Location:
- LMDZ6/trunk/libf/phylmd
- Files:
-
- 1 edited
- 5 moved
-
lmdz_thermcell_dq.f90 (moved) (moved from LMDZ6/trunk/libf/phylmd/lmdz_thermcell_dq.F90) (3 diffs)
-
lmdz_thermcell_ini.f90 (modified) (4 diffs)
-
lmdz_thermcell_old.f90 (moved) (moved from LMDZ6/trunk/libf/phylmd/lmdz_thermcell_old.F90) (2 diffs)
-
lmdz_thermcell_plume.f90 (moved) (moved from LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume.F90) (1 diff)
-
lmdz_thermcell_plume_6A.f90 (moved) (moved from LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume_6A.F90) (2 diffs)
-
lmdz_wake_ini.f90 (moved) (moved from LMDZ6/trunk/libf/phylmd/lmdz_wake_ini.F90) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/lmdz_thermcell_dq.f90
r5433 r5434 160 160 & masse,q,dq,qa,lev_out) 161 161 USE print_control_mod, ONLY: prt_level 162 USE lmdz_thermcell_ini, ONLY : thermals_subsid_advect_scheme,thermals_subsid_advect_more_than_one 162 163 implicit none 163 164 … … 208 209 enddo 209 210 210 !IM 090508 print*,'CFL CFL CFL CFL ',cfl 211 212 #undef CFL 213 #ifdef CFL 214 ! On subdivise le calcul en niter pas de temps. 215 niter=int(cfl)+1 216 #else 211 212 ! niter=int(cfl)+1 ! pour tourner avec un CFL différent en splitant 217 213 niter=1 218 #endif219 214 220 215 ztimestep=ptimestep/niter … … 271 266 ! Calcul du flux subsident 272 267 273 do k=2,nlay 274 do ig=1,ngrid 275 #undef centre 276 #ifdef centre 277 wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k)) 278 #else 279 280 #define plusqueun 281 #ifdef plusqueun 282 ! Schema avec advection sur plus qu'une maille. 283 zzm=masse(ig,k)/ztimestep 284 if (fm(ig,k)>zzm) then 285 wqd(ig,k)=zzm*q(ig,k)+(fm(ig,k)-zzm)*q(ig,k+1) 286 else 287 wqd(ig,k)=fm(ig,k)*q(ig,k) 288 endif 289 #else 290 wqd(ig,k)=fm(ig,k)*q(ig,k) 291 #endif 292 #endif 293 294 if (wqd(ig,k).lt.0.) then 295 ! print*,'wqd<0!!!' 296 endif 297 enddo 298 enddo 268 if ( thermals_subsid_advect_scheme == 'center' ) then 269 do k=2,nlay 270 do ig=1,ngrid 271 wqd(ig,k)=fm(ig,k)*0.5*(q(ig,k-1)+q(ig,k)) 272 enddo 273 enddo 274 else ! upstream scheme (default and recomanded) 275 do k=2,nlay 276 do ig=1,ngrid 277 zzm=masse(ig,k)/ztimestep 278 if ( fm(ig,k)<=zzm .or. thermals_subsid_advect_more_than_one == 0 ) then 279 wqd(ig,k)=fm(ig,k)*q(ig,k) 280 else 281 wqd(ig,k)=zzm*q(ig,k)+(fm(ig,k)-zzm)*q(ig,k+1) 282 endif 283 enddo 284 enddo 285 endif 299 286 do ig=1,ngrid 300 287 wqd(ig,1)=0. -
LMDZ6/trunk/libf/phylmd/lmdz_thermcell_ini.f90
r5400 r5434 8 8 integer, protected :: dvdq=1,dqimpl=-1,prt_level=0,lunout 9 9 real , protected :: RG,RD,RCPD,RKAPPA,RLVTT,RLvCp,RETV 10 11 10 12 11 13 !$OMP THREADPRIVATE(dvdq,dqimpl,prt_level,lunout) … … 47 49 !$OMP THREADPRIVATE(iflag_thermals_tenv) 48 50 51 integer, protected :: thermals_subsid_advect_more_than_one=1 52 character*6, protected :: thermals_subsid_advect_scheme = 'upwind' ! or 'center' 53 54 !$OMP THREADPRIVATE(thermals_subsid_advect_scheme,thermals_subsid_advect_more_than_one) 49 55 50 56 CONTAINS … … 101 107 CALL getin_p('thermals_flag_alim',thermals_flag_alim) 102 108 CALL getin_p('iflag_thermals_tenv',iflag_thermals_tenv) 103 109 CALL getin_p('thermals_subsid_advect_scheme',thermals_subsid_advect_scheme) 110 CALL getin_p('thermals_subsid_advect_more_than_one',thermals_subsid_advect_more_than_one) 104 111 105 112 … … 134 141 write(lunout,*) 'thermcell_ini ,thermals_flag_alim =', thermals_flag_alim 135 142 write(lunout,*) 'thermcell_ini ,iflag_thermals_tenv =', iflag_thermals_tenv 143 write(lunout,*) 'thermcell_ini ,thermals_subsid_advect_scheme=',thermals_subsid_advect_scheme 144 write(lunout,*) 'thermcell_ini ,thermals_subsid_advect_more_than_one=',thermals_subsid_advect_more_than_one 136 145 137 146 RETURN -
LMDZ6/trunk/libf/phylmd/lmdz_thermcell_old.f90
r5433 r5434 4063 4063 END DO 4064 4064 4065 ! deja fait4066 ! do l=1,nlay4067 ! do ig=1,ngrid4068 ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)4069 ! if (detr(ig,l).lt.0.) then4070 ! entr(ig,l)=entr(ig,l)-detr(ig,l)4071 ! detr(ig,l)=0.4072 ! print*,'WARNING !!! detrainement negatif ',ig,l4073 ! endif4074 ! enddo4075 ! enddo4076 4077 ! print*,'15 OK convect8'4078 4079 4080 ! #define und4081 GO TO 1234082 #ifdef und4083 CALL writeg1d(1, nlay, wd, 'wd ', 'wd ')4084 CALL writeg1d(1, nlay, zwa, 'wa ', 'wa ')4085 CALL writeg1d(1, nlay, fracd, 'fracd ', 'fracd ')4086 CALL writeg1d(1, nlay, fraca, 'fraca ', 'fraca ')4087 CALL writeg1d(1, nlay, wa_moy, 'wam ', 'wam ')4088 CALL writeg1d(1, nlay, zla, 'la ', 'la ')4089 CALL writeg1d(1, nlay, zld, 'ld ', 'ld ')4090 CALL writeg1d(1, nlay, pt, 'pt ', 'pt ')4091 CALL writeg1d(1, nlay, zh, 'zh ', 'zh ')4092 CALL writeg1d(1, nlay, zha, 'zha ', 'zha ')4093 CALL writeg1d(1, nlay, zu, 'zu ', 'zu ')4094 CALL writeg1d(1, nlay, zv, 'zv ', 'zv ')4095 CALL writeg1d(1, nlay, zo, 'zo ', 'zo ')4096 CALL writeg1d(1, nlay, wh, 'wh ', 'wh ')4097 CALL writeg1d(1, nlay, wu, 'wu ', 'wu ')4098 CALL writeg1d(1, nlay, wv, 'wv ', 'wv ')4099 CALL writeg1d(1, nlay, wo, 'w15uo ', 'wXo ')4100 CALL writeg1d(1, nlay, zdhadj, 'zdhadj ', 'zdhadj ')4101 CALL writeg1d(1, nlay, pduadj, 'pduadj ', 'pduadj ')4102 CALL writeg1d(1, nlay, pdvadj, 'pdvadj ', 'pdvadj ')4103 CALL writeg1d(1, nlay, pdoadj, 'pdoadj ', 'pdoadj ')4104 CALL writeg1d(1, nlay, entr, 'entr ', 'entr ')4105 CALL writeg1d(1, nlay, detr, 'detr ', 'detr ')4106 CALL writeg1d(1, nlay, fm, 'fm ', 'fm ')4107 4108 CALL writeg1d(1, nlay, pdtadj, 'pdtadj ', 'pdtadj ')4109 CALL writeg1d(1, nlay, pplay, 'pplay ', 'pplay ')4110 CALL writeg1d(1, nlay, pplev, 'pplev ', 'pplev ')4111 4112 ! recalcul des flux en diagnostique...4113 ! print*,'PAS DE TEMPS ',ptimestep4114 CALL dt2f(pplev, pplay, pt, pdtadj, wh)4115 CALL writeg1d(1, nlay, wh, 'wh2 ', 'wh2 ')4116 #endif4117 123 CONTINUE4118 4119 4065 END IF 4120 4066 4121 ! if(wa_moy(1,4).gt.1.e-10) stop4122 4123 ! print*,'19 OK convect8'4124 4067 RETURN 4125 4068 END SUBROUTINE thermcell … … 6285 6228 isplit = isplit + 1 6286 6229 6287 6288 ! #define und6289 GO TO 1236290 #ifdef und6291 CALL writeg1d(1, nlay, wd, 'wd ', 'wd ')6292 CALL writeg1d(1, nlay, zwa, 'wa ', 'wa ')6293 CALL writeg1d(1, nlay, fracd, 'fracd ', 'fracd ')6294 CALL writeg1d(1, nlay, fraca, 'fraca ', 'fraca ')6295 CALL writeg1d(1, nlay, wa_moy, 'wam ', 'wam ')6296 CALL writeg1d(1, nlay, zla, 'la ', 'la ')6297 CALL writeg1d(1, nlay, zld, 'ld ', 'ld ')6298 CALL writeg1d(1, nlay, pt, 'pt ', 'pt ')6299 CALL writeg1d(1, nlay, zh, 'zh ', 'zh ')6300 CALL writeg1d(1, nlay, zha, 'zha ', 'zha ')6301 CALL writeg1d(1, nlay, zu, 'zu ', 'zu ')6302 CALL writeg1d(1, nlay, zv, 'zv ', 'zv ')6303 CALL writeg1d(1, nlay, zo, 'zo ', 'zo ')6304 CALL writeg1d(1, nlay, wh, 'wh ', 'wh ')6305 CALL writeg1d(1, nlay, wu, 'wu ', 'wu ')6306 CALL writeg1d(1, nlay, wv, 'wv ', 'wv ')6307 CALL writeg1d(1, nlay, wo, 'w15uo ', 'wXo ')6308 CALL writeg1d(1, nlay, zdhadj, 'zdhadj ', 'zdhadj ')6309 CALL writeg1d(1, nlay, pduadj, 'pduadj ', 'pduadj ')6310 CALL writeg1d(1, nlay, pdvadj, 'pdvadj ', 'pdvadj ')6311 CALL writeg1d(1, nlay, pdoadj, 'pdoadj ', 'pdoadj ')6312 CALL writeg1d(1, nlay, entr, 'entr ', 'entr ')6313 CALL writeg1d(1, nlay, detr, 'detr ', 'detr ')6314 CALL writeg1d(1, nlay, fm, 'fm ', 'fm ')6315 6316 CALL writeg1d(1, nlay, pdtadj, 'pdtadj ', 'pdtadj ')6317 CALL writeg1d(1, nlay, pplay, 'pplay ', 'pplay ')6318 CALL writeg1d(1, nlay, pplev, 'pplev ', 'pplev ')6319 6320 ! recalcul des flux en diagnostique...6321 ! print*,'PAS DE TEMPS ',ptimestep6322 CALL dt2f(pplev, pplay, pt, pdtadj, wh)6323 CALL writeg1d(1, nlay, wh, 'wh2 ', 'wh2 ')6324 #endif6325 123 CONTINUE6326 6327 6230 END IF 6328 6231 -
LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume.f90
r5433 r5434 438 438 if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l 439 439 440 #undef wrgrads_thermcell441 #ifdef wrgrads_thermcell442 call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta ','esta ')443 call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta ','dsta ')444 call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy ','buoy ')445 call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt ','dqt ')446 call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est ','w_est ')447 call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2 ','w_es2 ')448 call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A ','zw2A ')449 #endif450 451 440 452 441 RETURN -
LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume_6A.f90
r5433 r5434 684 684 if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l 685 685 686 #undef wrgrads_thermcell687 #ifdef wrgrads_thermcell688 call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta ','esta ')689 call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta ','dsta ')690 call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy ','buoy ')691 call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt ','dqt ')692 call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est ','w_est ')693 call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2 ','w_es2 ')694 call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A ','zw2A ')695 #endif696 697 698 686 RETURN 699 687 END SUBROUTINE thermcell_plume_6A … … 1102 1090 if (prt_level.ge.20) print*,'coucou calcul detr 470: ig, l', ig, l 1103 1091 1104 #undef wrgrads_thermcell1105 #ifdef wrgrads_thermcell1106 call wrgradsfi(1,nlay,entr_star(igout,1:nlay),'esta ','esta ')1107 call wrgradsfi(1,nlay,detr_star(igout,1:nlay),'dsta ','dsta ')1108 call wrgradsfi(1,nlay,zbuoy(igout,1:nlay),'buoy ','buoy ')1109 call wrgradsfi(1,nlay,zdqt(igout,1:nlay),'dqt ','dqt ')1110 call wrgradsfi(1,nlay,w_est(igout,1:nlay),'w_est ','w_est ')1111 call wrgradsfi(1,nlay,w_est(igout,2:nlay+1),'w_es2 ','w_es2 ')1112 call wrgradsfi(1,nlay,zw2(igout,1:nlay),'zw2A ','zw2A ')1113 #endif1114 1115 1116 1092 return 1117 1093 END SUBROUTINE thermcell_plume_5B -
LMDZ6/trunk/libf/phylmd/lmdz_wake_ini.f90
r5433 r5434 82 82 83 83 ! CPP key used only in this module for debugging purposes. jyg 09/24 84 !!#define IOPHYS_WK 85 #ifdef IOPHYS_WK 86 LOGICAL, PARAMETER :: CPPKEY_IOPHYS_WK = .TRUE. 87 #else 88 LOGICAL, PARAMETER :: CPPKEY_IOPHYS_WK = .FALSE. 89 #endif 84 LOGICAL, SAVE, PROTECTED :: CPPKEY_IOPHYS_WK = .FALSE. 85 !$OMP THREADPRIVATE(CPPKEY_IOPHYS_WK) 90 86 91 87 … … 253 249 wk_frac_int_delta_t = 0.9 254 250 CALL getin_p('wk_frac_int_delta_t', wk_frac_int_delta_t) 251 252 CALL getin_p('CPPKEY_IOPHYS_WK', CPPKEY_IOPHYS_WK) 255 253 256 254
Note: See TracChangeset
for help on using the changeset viewer.
