Changeset 2716
- Timestamp:
- Nov 28, 2016, 11:01:20 PM (8 years ago)
- Location:
- LMDZ5/trunk/libf/phylmd/dyn1d
- Files:
-
- 1 added
- 6 edited
-
1DUTILS.h (modified) (10 diffs)
-
1D_decl_cases.h (modified) (2 diffs)
-
1D_interp_cases.h (modified) (1 diff)
-
1D_read_forc_cases.h (modified) (1 diff)
-
compar1d.h (modified) (3 diffs)
-
lmdz1d.F90 (modified) (10 diffs)
-
mod_1D_cases_read2.F90 (added)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/dyn1d/1DUTILS.h
r2683 r2716 55 55 56 56 !Config Key = prt_level 57 !Config Desc = niveau d'impressions de d ?bogage57 !Config Desc = niveau d'impressions de debogage 58 58 !Config Def = 0 59 !Config Help = Niveau d'impression pour le d ?bogage59 !Config Help = Niveau d'impression pour le debogage 60 60 !Config (0 = minimum d'impression) 61 61 ! prt_level = 0 … … 118 118 ! use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s 119 119 ! Radiation to be switched off 120 ! > 100 ==> forcing_case = .true. or forcing_case2 = .true. 121 ! initial profiles from case.nc file 120 122 ! 121 123 forcing_type = 0 … … 134 136 ENDIF 135 137 136 !Param ?tres de for?age138 !Parametres de forcage 137 139 !Config Key = tend_t 138 140 !Config Desc = forcage ou non par advection de T … … 394 396 CALL getin('tau_soil_nudge',tau_soil_nudge) 395 397 398 !---------------------------------------------------------- 399 ! Param??tres de for??age pour les forcages communs: 400 ! Pour les forcages communs: ces entiers valent 0 ou 1 401 ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale 402 ! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale 403 ! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv) 404 ! forcages en omega, w, vent geostrophique ou ustar 405 ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging 406 !---------------------------------------------------------- 407 408 !Config Key = tadv 409 !Config Desc = forcage ou non par advection totale de T 410 !Config Def = false 411 !Config Help = forcage ou non par advection totale de T 412 tadv =0 413 CALL getin('tadv',tadv) 414 415 !Config Key = tadvv 416 !Config Desc = forcage ou non par advection verticale de T 417 !Config Def = false 418 !Config Help = forcage ou non par advection verticale de T 419 tadvv =0 420 CALL getin('tadvv',tadvv) 421 422 !Config Key = tadvh 423 !Config Desc = forcage ou non par advection horizontale de T 424 !Config Def = false 425 !Config Help = forcage ou non par advection horizontale de T 426 tadvh =0 427 CALL getin('tadvh',tadvh) 428 429 !Config Key = thadv 430 !Config Desc = forcage ou non par advection totale de Theta 431 !Config Def = false 432 !Config Help = forcage ou non par advection totale de Theta 433 thadv =0 434 CALL getin('thadv',thadv) 435 436 !Config Key = thadvv 437 !Config Desc = forcage ou non par advection verticale de Theta 438 !Config Def = false 439 !Config Help = forcage ou non par advection verticale de Theta 440 thadvv =0 441 CALL getin('thadvv',thadvv) 442 443 !Config Key = thadvh 444 !Config Desc = forcage ou non par advection horizontale de Theta 445 !Config Def = false 446 !Config Help = forcage ou non par advection horizontale de Theta 447 thadvh =0 448 CALL getin('thadvh',thadvh) 449 450 !Config Key = qadv 451 !Config Desc = forcage ou non par advection totale de Q 452 !Config Def = false 453 !Config Help = forcage ou non par advection totale de Q 454 qadv =0 455 CALL getin('qadv',qadv) 456 457 !Config Key = qadvv 458 !Config Desc = forcage ou non par advection verticale de Q 459 !Config Def = false 460 !Config Help = forcage ou non par advection verticale de Q 461 qadvv =0 462 CALL getin('qadvv',qadvv) 463 464 !Config Key = qadvh 465 !Config Desc = forcage ou non par advection horizontale de Q 466 !Config Def = false 467 !Config Help = forcage ou non par advection horizontale de Q 468 qadvh =0 469 CALL getin('qadvh',qadvh) 470 471 !Config Key = trad 472 !Config Desc = forcage ou non par tendance radiative 473 !Config Def = false 474 !Config Help = forcage ou non par tendance radiative 475 trad =0 476 CALL getin('trad',trad) 477 478 !Config Key = forc_omega 479 !Config Desc = forcage ou non par omega 480 !Config Def = false 481 !Config Help = forcage ou non par omega 482 forc_omega =0 483 CALL getin('forc_omega',forc_omega) 484 485 !Config Key = forc_w 486 !Config Desc = forcage ou non par w 487 !Config Def = false 488 !Config Help = forcage ou non par w 489 forc_w =0 490 CALL getin('forc_w',forc_w) 491 492 !Config Key = forc_geo 493 !Config Desc = forcage ou non par geo 494 !Config Def = false 495 !Config Help = forcage ou non par geo 496 forc_geo =0 497 CALL getin('forc_geo',forc_geo) 498 499 ! Meme chose que ok_precr_ust 500 !Config Key = forc_ustar 501 !Config Desc = forcage ou non par ustar 502 !Config Def = false 503 !Config Help = forcage ou non par ustar 504 forc_ustar =0 505 CALL getin('forc_ustar',forc_ustar) 506 IF (forc_ustar .EQ. 1) ok_prescr_ust=.true. 507 508 !Config Key = nudging_u 509 !Config Desc = forcage ou non par nudging sur u 510 !Config Def = false 511 !Config Help = forcage ou non par nudging sur u 512 nudging_u =0 513 CALL getin('nudging_u',nudging_u) 514 515 !Config Key = nudging_v 516 !Config Desc = forcage ou non par nudging sur v 517 !Config Def = false 518 !Config Help = forcage ou non par nudging sur v 519 nudging_v =0 520 CALL getin('nudging_v',nudging_v) 521 522 !Config Key = nudging_w 523 !Config Desc = forcage ou non par nudging sur w 524 !Config Def = false 525 !Config Help = forcage ou non par nudging sur w 526 nudging_w =0 527 CALL getin('nudging_w',nudging_w) 528 529 !Config Key = nudging_q 530 !Config Desc = forcage ou non par nudging sur q 531 !Config Def = false 532 !Config Help = forcage ou non par nudging sur q 533 nudging_q =0 534 CALL getin('nudging_q',nudging_q) 535 536 !Config Key = nudging_t 537 !Config Desc = forcage ou non par nudging sur t 538 !Config Def = false 539 !Config Help = forcage ou non par nudging sur t 540 nudging_t =0 541 CALL getin('nudging_t',nudging_t) 396 542 397 543 … … 423 569 write(lunout,*)' Tsoil_nudge = ', Tsoil_nudge 424 570 write(lunout,*)' tau_soil_nudge = ', tau_soil_nudge 571 write(lunout,*)' tadv = ', tadv 572 write(lunout,*)' tadvv = ', tadvv 573 write(lunout,*)' tadvh = ', tadvh 574 write(lunout,*)' thadv = ', thadv 575 write(lunout,*)' thadvv = ', thadvv 576 write(lunout,*)' thadvh = ', thadvh 577 write(lunout,*)' qadv = ', qadv 578 write(lunout,*)' qadvv = ', qadvv 579 write(lunout,*)' qadvh = ', qadvh 580 write(lunout,*)' trad = ', trad 581 write(lunout,*)' forc_omega = ', forc_omega 582 write(lunout,*)' forc_w = ', forc_w 583 write(lunout,*)' forc_geo = ', forc_geo 584 write(lunout,*)' forc_ustar = ', forc_ustar 585 write(lunout,*)' nudging_u = ', nudging_u 586 write(lunout,*)' nudging_v = ', nudging_v 587 write(lunout,*)' nudging_t = ', nudging_t 588 write(lunout,*)' nudging_q = ', nudging_q 425 589 IF (forcing_type .eq.40) THEN 426 590 write(lunout,*) '--- Forcing type GCSS Old --- with:' … … 1123 1287 !---------------------------------------------------------------------- 1124 1288 ! Calcul de l'advection verticale (ascendance et subsidence) de 1125 ! temp ?rature et d'humidit?. Hypoth?se : ce qui rentre de l'ext?rieur1126 ! a les m ?mes caract?ristiques que l'air de la colonne 1D (WTG) ou1289 ! temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur 1290 ! a les memes caracteristiques que l'air de la colonne 1D (WTG) ou 1127 1291 ! sans WTG rajouter une advection horizontale 1128 1292 !---------------------------------------------------------------------- … … 1197 1361 !---------------------------------------------------------------------- 1198 1362 ! Calcul de l'advection verticale (ascendance et subsidence) de 1199 ! temp ?rature et d'humidit?. Hypoth?se : ce qui rentre de l'ext?rieur1200 ! a les m ?mes caract?ristiques que l'air de la colonne 1D (WTG) ou1363 ! temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur 1364 ! a les memes caracteristiques que l'air de la colonne 1D (WTG) ou 1201 1365 ! sans WTG rajouter une advection horizontale 1202 1366 !---------------------------------------------------------------------- … … 2951 3115 endif 2952 3116 if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then 2953 print*,'TOGA-COARE a d ?but?le 1er Nov 1992 (jour julien=306)'3117 print*,'TOGA-COARE a debute le 1er Nov 1992 (jour julien=306)' 2954 3118 print*,'Changer dayref dans run.def' 2955 3119 stop … … 4804 4968 ! 4805 4969 ! Cette formule remplace d_q = (1/tau) [rh_targ - rh] qsat(T_new) 4806 ! qui n' ?tait pas correcte.4970 ! qui n'etait pas correcte. 4807 4971 ! 4808 4972 IF (tnew.LT.RTT) THEN … … 4879 5043 END 4880 5044 4881 5045 !===================================================================== 5046 SUBROUTINE interp2_case_vertical(play,nlev_cas,plev_prof_cas & 5047 & ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas & 5048 & ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas & 5049 & ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & 5050 & ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & 5051 & ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 5052 & ,dth_prof_cas,hth_prof_cas,vth_prof_cas & 5053 ! 5054 & ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas & 5055 & ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas & 5056 & ,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas & 5057 & ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & 5058 & ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas & 5059 & ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc) 5060 5061 implicit none 5062 5063 #include "dimensions.h" 5064 5065 !------------------------------------------------------------------------- 5066 ! Vertical interpolation of generic case forcing data onto mod_casel levels 5067 !------------------------------------------------------------------------- 5068 5069 integer nlevmax 5070 parameter (nlevmax=41) 5071 integer nlev_cas,mxcalc 5072 ! real play(llm), plev_prof(nlevmax) 5073 ! real t_prof(nlevmax),q_prof(nlevmax) 5074 ! real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax) 5075 ! real ht_prof(nlevmax),vt_prof(nlevmax) 5076 ! real hq_prof(nlevmax),vq_prof(nlevmax) 5077 5078 real play(llm), plev_prof_cas(nlev_cas) 5079 real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas) 5080 real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas) 5081 real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas) 5082 real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas) 5083 real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas) 5084 real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas) 5085 real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas) 5086 real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas) 5087 real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas) 5088 5089 real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm) 5090 real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm) 5091 real u_mod_cas(llm),v_mod_cas(llm) 5092 real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm) 5093 real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm) 5094 real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm) 5095 real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm) 5096 real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm) 5097 real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm) 5098 5099 integer l,k,k1,k2 5100 real frac,frac1,frac2,fact 5101 5102 do l = 1, llm 5103 print *,'debut interp2, play=',l,play(l) 5104 enddo 5105 ! do l = 1, nlev_cas 5106 ! print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l) 5107 ! enddo 5108 5109 do l = 1, llm 5110 5111 if (play(l).ge.plev_prof_cas(nlev_cas)) then 5112 5113 mxcalc=l 5114 print *,'debut interp2, mxcalc=',mxcalc 5115 k1=0 5116 k2=0 5117 5118 if (play(l).le.plev_prof_cas(1)) then 5119 5120 do k = 1, nlev_cas-1 5121 if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then 5122 k1=k 5123 k2=k+1 5124 endif 5125 enddo 5126 5127 if (k1.eq.0 .or. k2.eq.0) then 5128 write(*,*) 'PB! k1, k2 = ',k1,k2 5129 write(*,*) 'l,play(l) = ',l,play(l)/100 5130 do k = 1, nlev_cas-1 5131 write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100 5132 enddo 5133 endif 5134 5135 frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1)) 5136 t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1)) 5137 theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1)) 5138 thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1)) 5139 thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1)) 5140 qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1)) 5141 ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1)) 5142 qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1)) 5143 u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1)) 5144 v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1)) 5145 ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1)) 5146 vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1)) 5147 w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1)) 5148 omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1)) 5149 du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1)) 5150 hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1)) 5151 vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1)) 5152 dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1)) 5153 hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1)) 5154 vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1)) 5155 dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1)) 5156 ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1)) 5157 vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1)) 5158 dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1)) 5159 hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1)) 5160 vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1)) 5161 dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1)) 5162 hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1)) 5163 vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1)) 5164 5165 else !play>plev_prof_cas(1) 5166 5167 k1=1 5168 k2=2 5169 print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2) 5170 frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2)) 5171 frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2)) 5172 t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2) 5173 theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2) 5174 thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2) 5175 thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2) 5176 qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2) 5177 ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2) 5178 qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2) 5179 u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2) 5180 v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2) 5181 ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2) 5182 vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2) 5183 w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2) 5184 omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2) 5185 du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2) 5186 hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2) 5187 vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2) 5188 dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2) 5189 hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2) 5190 vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2) 5191 dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2) 5192 ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2) 5193 vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2) 5194 dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2) 5195 hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2) 5196 vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2) 5197 dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2) 5198 hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2) 5199 vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2) 5200 5201 endif ! play.le.plev_prof_cas(1) 5202 5203 else ! above max altitude of forcing file 5204 5205 !jyg 5206 fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg 5207 fact = max(fact,0.) !jyg 5208 fact = exp(-fact) !jyg 5209 t_mod_cas(l)= t_prof_cas(nlev_cas) !jyg 5210 theta_mod_cas(l)= th_prof_cas(nlev_cas) !jyg 5211 thv_mod_cas(l)= thv_prof_cas(nlev_cas) !jyg 5212 thl_mod_cas(l)= thl_prof_cas(nlev_cas) !jyg 5213 qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact !jyg 5214 ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact !jyg 5215 qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact !jyg 5216 u_mod_cas(l)= u_prof_cas(nlev_cas)*fact !jyg 5217 v_mod_cas(l)= v_prof_cas(nlev_cas)*fact !jyg 5218 ug_mod_cas(l)= ug_prof_cas(nlev_cas)*fact !jyg 5219 vg_mod_cas(l)= vg_prof_cas(nlev_cas)*fact !jyg 5220 w_mod_cas(l)= 0.0 !jyg 5221 du_mod_cas(l)= du_prof_cas(nlev_cas)*fact 5222 hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact !jyg 5223 vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact !jyg 5224 dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact 5225 hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact !jyg 5226 vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact !jyg 5227 dt_mod_cas(l)= dt_prof_cas(nlev_cas) 5228 ht_mod_cas(l)= ht_prof_cas(nlev_cas) !jyg 5229 vt_mod_cas(l)= vt_prof_cas(nlev_cas) !jyg 5230 dth_mod_cas(l)= dth_prof_cas(nlev_cas) 5231 hth_mod_cas(l)= hth_prof_cas(nlev_cas) !jyg 5232 vth_mod_cas(l)= vth_prof_cas(nlev_cas) !jyg 5233 dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact 5234 hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact !jyg 5235 vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact !jyg 5236 5237 endif ! play 5238 5239 enddo ! l 5240 5241 ! do l = 1,llm 5242 ! print *,'t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) ', 5243 ! $ l,t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) 5244 ! enddo 5245 5246 return 5247 end 5248 !***************************************************************************** 5249 5250 -
LMDZ5/trunk/libf/phylmd/dyn1d/1D_decl_cases.h
r2683 r2716 243 243 real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm) 244 244 !vertical advection computation 245 real d_t_z(llm), d_q_z(llm)246 real d_t_dyn_z(llm), d_q_dyn_z(llm)245 real d_t_z(llm),d_th_z(llm), d_q_z(llm) 246 real d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm) 247 247 real d_u_z(llm),d_v_z(llm) 248 248 real d_u_dyn(llm),d_v_dyn(llm) … … 278 278 279 279 real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm) 280 real theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm) 281 real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm) 280 282 real ug_mod_cas(llm),vg_mod_cas(llm) 281 283 real u_mod_cas(llm),v_mod_cas(llm) 284 real omega_mod_cas(llm) 282 285 real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm) 286 real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm) 283 287 real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm) 284 288 real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm) -
LMDZ5/trunk/libf/phylmd/dyn1d/1D_interp_cases.h
r2683 r2716 805 805 enddo 806 806 807 ! Faut-il multiplier par -1 ? (MPL 20160713) 808 IF(ok_flux_surf) THEN 809 fsens=sens_prof_cas 810 flat=lat_prof_cas 811 ENDIF 812 ! 813 IF (ok_prescr_ust) THEN 814 ust=ustar_prof_cas 815 print *,'ust=',ust 816 ENDIF 807 817 endif ! forcing_case 808 818 809 819 810 820 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 811 812 821 !--------------------------------------------------------------------- 822 ! Interpolation forcing standard case 823 !--------------------------------------------------------------------- 824 if (forcing_case2) then 825 826 print*, & 827 & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=', & 828 & daytime,day1,(daytime-day1)*86400., & 829 & (daytime-day1)*86400/pdt_cas 830 831 ! time interpolation: 832 CALL interp2_case_time(daytime,day1,annee_ref & 833 ! & ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas & 834 & ,nt_cas,nlev_cas & 835 & ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas & 836 & ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas & 837 & ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 838 & ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas & 839 & ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas & 840 ! 841 & ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas & 842 & ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & 843 & ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & 844 & ,du_prof_cas,hu_prof_cas,vu_prof_cas & 845 & ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas & 846 & ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 847 & ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas & 848 & ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas) 849 850 ts_cur = ts_prof_cas 851 ! psurf=plev_prof_cas(1) 852 psurf=ps_prof_cas 853 854 ! vertical interpolation: 855 CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas & 856 & ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas & 857 & ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas & 858 & ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & 859 & ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & 860 & ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 861 & ,dth_prof_cas,hth_prof_cas,vth_prof_cas & 862 ! 863 & ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas & 864 & ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas & 865 & ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & 866 & ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas & 867 & ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc) 868 869 870 DO l=1,llm 871 teta(l)=temp(l)*(100000./play(l))**(rd/rcpd) 872 ENDDO 873 !calcul de l'advection verticale a partir du omega 874 !Calcul des gradients verticaux 875 !initialisation 876 d_t_z(:)=0. 877 d_th_z(:)=0. 878 d_q_z(:)=0. 879 d_t_dyn_z(:)=0. 880 d_th_dyn_z(:)=0. 881 d_q_dyn_z(:)=0. 882 DO l=2,llm-1 883 d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1)) 884 d_th_z(l)=(teta(l+1)-teta(l-1))/(play(l+1)-play(l-1)) 885 d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1)) 886 ENDDO 887 d_t_z(1)=d_t_z(2) 888 d_th_z(1)=d_th_z(2) 889 d_q_z(1)=d_q_z(2) 890 d_t_z(llm)=d_t_z(llm-1) 891 d_th_z(llm)=d_th_z(llm-1) 892 d_q_z(llm)=d_q_z(llm-1) 893 894 !Calcul de l advection verticale 895 d_t_dyn_z(:)=w_mod_cas(:)*d_t_z(:) 896 d_th_dyn_z(:)=w_mod_cas(:)*d_th_z(:) 897 d_q_dyn_z(:)=w_mod_cas(:)*d_q_z(:) 898 899 !wind nudging 900 if (nudging_u.gt.0.) then 901 do l=1,llm 902 u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u) 903 enddo 904 else 905 do l=1,llm 906 ug(l) = u_mod_cas(l) 907 enddo 908 endif 909 910 if (nudging_v.gt.0.) then 911 do l=1,llm 912 v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v) 913 enddo 914 else 915 do l=1,llm 916 vg(l) = v_mod_cas(l) 917 enddo 918 endif 919 920 if (nudging_w.gt.0.) then 921 do l=1,llm 922 w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w) 923 enddo 924 else 925 do l=1,llm 926 w(l) = w_mod_cas(l) 927 enddo 928 endif 929 930 !nudging of q and temp 931 if (nudging_t.gt.0.) then 932 do l=1,llm 933 temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t) 934 enddo 935 endif 936 if (nudging_q.gt.0.) then 937 do l=1,llm 938 q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q) 939 enddo 940 endif 941 942 do l = 1, llm 943 omega(l) = w_mod_cas(l) 944 omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq 945 alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l) 946 947 !calcul advection 948 ! if ((tend_u.eq.1).and.(tend_w.eq.0)) then 949 ! d_u_adv(l)=du_mod_cas(l) 950 ! else if ((tend_u.eq.1).and.(tend_w.eq.1)) then 951 ! d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l) 952 ! endif 953 ! 954 ! if ((tend_v.eq.1).and.(tend_w.eq.0)) then 955 ! d_v_adv(l)=dv_mod_cas(l) 956 ! else if ((tend_v.eq.1).and.(tend_w.eq.1)) then 957 ! d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l) 958 ! endif 959 ! 960 !----------------------------------------------------- 961 if (tadv.eq.1 .or. tadvh.eq.1) then 962 d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l) 963 else if (tadvv.eq.1) then 964 ! ATTENTION d_t_dyn_z pas calcule (voir twpice) 965 d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l) 966 endif 967 print *,'interp_case d_t_dyn_z=',d_t_dyn_z(l),d_q_dyn_z(l) 968 969 ! Verifier le signe !! 970 if (thadv.eq.1 .or. thadvh.eq.1) then 971 d_th_adv(l)=dth_mod_cas(l) 972 print *,'dthadv=',d_th_adv(l)*86400. 973 else if (thadvv.eq.1) then 974 d_th_adv(l)=hth_mod_cas(l)-d_th_dyn_z(l) 975 endif 976 977 ! Verifier le signe !! 978 if ((qadv.eq.1).and.(forc_w.eq.0)) then 979 d_q_adv(l,1)=dq_mod_cas(l) 980 else if ((qadvh.eq.1).and.(forc_w.eq.1)) then 981 d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l) 982 endif 983 984 if (trad.eq.1) then 985 tend_rayo=1 986 dt_cooling(l) = dtrad_mod_cas(l) 987 ! print *,'dt_cooling=',dt_cooling(l) 988 else 989 dt_cooling(l) = 0.0 990 endif 991 enddo 992 993 ! Faut-il multiplier par -1 ? (MPL 20160713) 994 IF(ok_flux_surf) THEN 995 fsens=-1.*sens_prof_cas 996 flat=-1.*lat_prof_cas 997 print *,'1D_interp: sens,flat',fsens,flat 998 ENDIF 999 ! 1000 IF (ok_prescr_ust) THEN 1001 ust=ustar_prof_cas 1002 print *,'ust=',ust 1003 ENDIF 1004 endif ! forcing_case2 1005 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1006 -
LMDZ5/trunk/libf/phylmd/dyn1d/1D_read_forc_cases.h
r2683 r2716 909 909 endif !forcing_case 910 910 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 911 911 !--------------------------------------------------------------------- 912 ! Forcing from standard case : 913 !--------------------------------------------------------------------- 914 915 if (forcing_case2) then 916 917 write(*,*),'avant call read2_1D_cas' 918 call read2_1D_cas 919 write(*,*) 'Forcing read' 920 921 !Time interpolation for initial conditions using interpolation routine 922 write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1 923 CALL interp2_case_time(daytime,day1,annee_ref & 924 ! & ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas & 925 & ,nt_cas,nlev_cas & 926 & ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas & 927 & ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas & 928 & ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 929 & ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas & 930 & ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas & 931 ! 932 & ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas & 933 & ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas & 934 & ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & 935 & ,du_prof_cas,hu_prof_cas,vu_prof_cas & 936 & ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas & 937 & ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 938 & ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas & 939 & ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas) 940 941 do l = 1, nlev_cas 942 print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l) 943 enddo 944 945 ! vertical interpolation using interpolation routine: 946 ! write(*,*)'avant interp vert', t_prof 947 CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas & 948 & ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas & 949 & ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas & 950 & ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas & 951 & ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas & 952 & ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas & 953 & ,dth_prof_cas,hth_prof_cas,vth_prof_cas & 954 ! 955 & ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas & 956 & ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas & 957 & ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas & 958 & ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas & 959 & ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc) 960 961 ! write(*,*) 'Profil initial forcing case interpole',t_mod 962 963 ! initial and boundary conditions : 964 ! tsurf = ts_prof_cas 965 ts_cur = ts_prof_cas 966 psurf=plev_prof_cas(1) 967 write(*,*) 'SST initiale: ',tsurf 968 do l = 1, llm 969 temp(l) = t_mod_cas(l) 970 q(l,1) = qv_mod_cas(l) 971 q(l,2) = ql_mod_cas(l) 972 u(l) = u_mod_cas(l) 973 ug(l)= u_mod_cas(l) 974 v(l) = v_mod_cas(l) 975 vg(l)= v_mod_cas(l) 976 omega(l) = w_mod_cas(l) 977 omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq 978 979 alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l) 980 !on applique le forcage total au premier pas de temps 981 !attention: signe different de toga 982 d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l)) 983 d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l)) 984 ! d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l)) 985 d_q_adv(l,1) = dq_mod_cas(l) 986 d_q_adv(l,2) = 0.0 987 ! d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l)) 988 d_u_adv(l) = du_mod_cas(l) 989 ! d_u_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l)) 990 d_u_adv(l) = dv_mod_cas(l) 991 enddo 992 993 ! Faut-il multiplier par -1 ? (MPL 20160713) 994 IF (ok_flux_surf) THEN 995 fsens=-1.*sens_prof_cas 996 flat=-1.*lat_prof_cas 997 ENDIF 998 ! 999 IF (ok_prescr_ust) THEN 1000 ust=ustar_prof_cas 1001 print *,'ust=',ust 1002 ENDIF 1003 1004 endif !forcing_case2 1005 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1006 -
LMDZ5/trunk/libf/phylmd/dyn1d/compar1d.h
r2672 r2716 32 32 logical :: ok_old_disvert 33 33 34 ! Pour les forcages communs: ces entiers valent 0 ou 1 35 ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale 36 ! idem pour l advection en theta 37 ! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale 38 ! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv) 39 ! forcages en omega, w, vent geostrophique ou ustar 40 ! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging 41 42 integer :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad 43 integer :: forc_omega, forc_w, forc_geo, forc_ustar 44 real :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_q 34 45 common/com_par1d/ & 35 46 & nat_surf,tsurf,rugos,rugosh, & … … 39 50 & nudge_u,nudge_v,nudge_w,nudge_t,nudge_q, & 40 51 & iflag_nudge,snowmass, & 41 & restart,ok_old_disvert 52 & restart,ok_old_disvert, & 53 & tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, & 54 & trad, forc_omega, forc_w, forc_geo, forc_ustar, & 55 & nudging_u, nudging_v, nudging_t, nudging_q 42 56 43 57 !$OMP THREADPRIVATE(/com_par1d/) … … 52 66 53 67 68 -
LMDZ5/trunk/libf/phylmd/dyn1d/lmdz1d.F90
r2672 r2716 32 32 USE indice_sol_mod 33 33 USE phyaqua_mod 34 USE mod_1D_cases_read 34 ! USE mod_1D_cases_read 35 USE mod_1D_cases_read2 35 36 USE mod_1D_amma_read 36 37 USE print_control_mod, ONLY: lunout, prt_level … … 140 141 logical :: forcing_fire = .false. 141 142 logical :: forcing_case = .false. 143 logical :: forcing_case2 = .false. 142 144 integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file 143 145 ! (cf read_tsurf1d.F) … … 192 194 real :: du_phys(llm),dv_phys(llm),dt_phys(llm) 193 195 real :: dt_dyn(llm) 194 real :: dt_cooling(llm),d_t h_adv(llm),d_t_nudge(llm)196 real :: dt_cooling(llm),d_t_adv(llm),d_th_adv(llm),d_t_nudge(llm) 195 197 real :: d_u_nudge(llm),d_v_nudge(llm) 196 198 real :: du_adv(llm),dv_adv(llm) … … 332 334 ! 101=cindynamo 333 335 ! 102=bomex 336 !forcing_type >= 100 ==> forcing_case2 = .true. 337 ! temporary flag while all the 1D cases are not whith the same cas.nc forcing file 338 ! 103=arm_cu2 ie arm_cu with new forcing format 339 ! 104=rico2 ie rico with new forcing format 334 340 !forcing_type = 40 ==> forcing_GCSSold = .true. 335 341 ! initial profile from GCSS file … … 384 390 heure_ini_cas=0. 385 391 pdt_cas=1800. ! forcing frequency 392 elseif (forcing_type .eq.103) THEN ! Arm_cu starts 21-6-1997 11h30 393 forcing_case2 = .true. 394 year_ini_cas=1997 395 mth_ini_cas=6 396 day_deb=21 397 heure_ini_cas=11.5 398 pdt_cas=1800. ! forcing frequency 399 elseif (forcing_type .eq.104) THEN ! rico starts 16-12-2004 0h 400 forcing_case2 = .true. 401 year_ini_cas=2004 402 mth_ini_cas=12 403 day_deb=16 404 heure_ini_cas=0. 405 pdt_cas=1800. ! forcing frequency 386 406 elseif (forcing_type .eq.40) THEN 387 407 forcing_GCSSold = .true. … … 456 476 endif 457 477 print *,'fnday=',fnday 458 478 ! start_time doit etre en FRACTION DE JOUR 459 479 start_time=time_ini/24. 460 480 461 481 ! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026) 462 482 IF(forcing_type .EQ. 61) fnday=53100./86400. 483 IF(forcing_type .EQ. 103) fnday=53100./86400. 463 484 ! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216) 464 485 IF(forcing_type .EQ. 6) fnday=64800./86400. … … 505 526 print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas 506 527 call ymds2ju & 507 & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas 528 & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600 & 508 529 & ,day_ju_ini_cas) 509 530 print*,'time case 2',day_ini_cas,day_ju_ini_cas … … 527 548 ENDIF 528 549 550 IF (forcing_type .gt.100) THEN 551 daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation 552 ELSE 529 553 daytime = day + time_ini/24. ! 1st day and initial time of the simulation 554 ENDIF 530 555 ! Print out the actual date of the beginning of the simulation : 531 556 call ju2ymds(daytime,year_print, month_print,day_print,sec_print) … … 1034 1059 1035 1060 if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice & 1036 & .or.forcing_amma ) then1061 & .or.forcing_amma .or. forcing_type.eq.101) then 1037 1062 fcoriolis=0.0 ; ug=0. ; vg=0. 1038 1063 endif 1039 if(forcing_rico) then 1064 1065 if(forcing_rico) then 1040 1066 dt_cooling=0. 1041 1067 endif 1042 1068 1043 1069 IF (prt_level >= 5) print*, 'fcoriolis, xlat,mxcalc ', & … … 1201 1227 !#endif 1202 1228 1229
Note: See TracChangeset
for help on using the changeset viewer.
