Changeset 5087 for LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
- Timestamp:
- Jul 20, 2024, 12:00:23 PM (6 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90
r5075 r5087 125 125 print*,'Allocations OK' 126 126 call read_amma(nid,nlev_amma,nt_amma & 127 &,z_amma,plev_amma,th_amma,q_amma,u_amma,v_amma,vitw_amma &128 &,ht_amma,hq_amma,sens_amma,lat_amma)127 ,z_amma,plev_amma,th_amma,q_amma,u_amma,v_amma,vitw_amma & 128 ,ht_amma,hq_amma,sens_amma,lat_amma) 129 129 130 130 END SUBROUTINE read_1D_cases … … 172 172 !===================================================================== 173 173 subroutine read_amma(nid,nlevel,ntime & 174 &,zz,pp,temp,qv,u,v,dw &175 &,dt,dq,sens,flat)174 ,zz,pp,temp,qv,u,v,dw & 175 ,dt,dq,sens,flat) 176 176 177 177 !program reading forcings of the AMMA case study … … 345 345 !====================================================================== 346 346 SUBROUTINE interp_amma_time(day,day1,annee_ref & 347 &,year_ini_amma,day_ini_amma,nt_amma,dt_amma,nlev_amma &348 &,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma &349 &,vitw_prof,ht_prof,hq_prof,lat_prof,sens_prof)347 ,year_ini_amma,day_ini_amma,nt_amma,dt_amma,nlev_amma & 348 ,vitw_amma,ht_amma,hq_amma,lat_amma,sens_amma & 349 ,vitw_prof,ht_prof,hq_prof,lat_prof,sens_prof) 350 350 implicit none 351 351 … … 426 426 if (it_amma1 > nt_amma) then 427 427 write(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: ' & 428 &,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.428 ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400. 429 429 stop 430 430 endif … … 439 439 440 440 lat_prof = lat_amma(it_amma2) & 441 & -frac*(lat_amma(it_amma2)-lat_amma(it_amma1))441 -frac*(lat_amma(it_amma2)-lat_amma(it_amma1)) 442 442 sens_prof = sens_amma(it_amma2) & 443 &-frac*(sens_amma(it_amma2)-sens_amma(it_amma1))443 -frac*(sens_amma(it_amma2)-sens_amma(it_amma1)) 444 444 445 445 do k=1,nlev_amma 446 446 vitw_prof(k) = vitw_amma(k,it_amma2) & 447 &-frac*(vitw_amma(k,it_amma2)-vitw_amma(k,it_amma1))447 -frac*(vitw_amma(k,it_amma2)-vitw_amma(k,it_amma1)) 448 448 ht_prof(k) = ht_amma(k,it_amma2) & 449 &-frac*(ht_amma(k,it_amma2)-ht_amma(k,it_amma1))449 -frac*(ht_amma(k,it_amma2)-ht_amma(k,it_amma1)) 450 450 hq_prof(k) = hq_amma(k,it_amma2) & 451 &-frac*(hq_amma(k,it_amma2)-hq_amma(k,it_amma1))451 -frac*(hq_amma(k,it_amma2)-hq_amma(k,it_amma1)) 452 452 enddo 453 453 -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90
r5075 r5087 184 184 print*,'Allocations OK' 185 185 call read_cas(nid,nlev_cas,nt_cas & 186 &,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas &187 &,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas &188 &,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas &189 &,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas&190 &,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas)186 ,z_cas,plev_cas,t_cas,q_cas,rh_cas,th_cas,rv_cas,u_cas,v_cas & 187 ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas,dv_cas,hv_cas,vv_cas & 188 ,dt_cas,dtrad_cas,ht_cas,vt_cas,dq_cas,hq_cas,vq_cas & 189 ,dth_cas,hth_cas,vth_cas,dr_cas,hr_cas,vr_cas,sens_cas,lat_cas,ts_cas& 190 ,ustar_cas,uw_cas,vw_cas,q1_cas,q2_cas) 191 191 print*,'Read cas OK' 192 192 … … 255 255 !===================================================================== 256 256 subroutine read_cas(nid,nlevel,ntime & 257 &,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w, &258 &du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq, &259 &dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2)257 ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w, & 258 du,hu,vu,dv,hv,vv,dt,dtrad,ht,vt,dq,hq,vq, & 259 dth,hth,vth,dr,hr,vr,sens,flat,ts,ustar,uw,vw,q1,q2) 260 260 261 261 !program reading forcing of the case study … … 804 804 SUBROUTINE interp_case_time(day,day1,annee_ref & 805 805 ! & ,year_cas,day_cas,nt_cas,pdt_forc,nlev_cas & 806 &,nt_cas,nlev_cas &807 &,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas &808 &,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas &809 &,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas &810 &,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas &811 &,uw_cas,vw_cas,q1_cas,q2_cas &812 &,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas &813 &,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas &814 &,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas &815 &,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas &816 &,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas &817 &,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas &818 &,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)806 ,nt_cas,nlev_cas & 807 ,ts_cas,plev_cas,t_cas,q_cas,u_cas,v_cas & 808 ,ug_cas,vg_cas,vitw_cas,du_cas,hu_cas,vu_cas & 809 ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas & 810 ,dq_cas,hq_cas,vq_cas,lat_cas,sens_cas,ustar_cas & 811 ,uw_cas,vw_cas,q1_cas,q2_cas & 812 ,ts_prof_cas,plev_prof_cas,t_prof_cas,q_prof_cas & 813 ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas & 814 ,vitw_prof_cas,du_prof_cas,hu_prof_cas,vu_prof_cas & 815 ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas & 816 ,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas & 817 ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas & 818 ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas) 819 819 820 820 … … 931 931 if (it_cas1 > nt_cas) then 932 932 write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: ' & 933 &,day,day_ju_ini_cas,it_cas1,it_cas2,timeit933 ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit 934 934 stop 935 935 endif … … 944 944 945 945 lat_prof_cas = lat_cas(it_cas2) & 946 &-frac*(lat_cas(it_cas2)-lat_cas(it_cas1))946 -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 947 947 sens_prof_cas = sens_cas(it_cas2) & 948 &-frac*(sens_cas(it_cas2)-sens_cas(it_cas1))948 -frac*(sens_cas(it_cas2)-sens_cas(it_cas1)) 949 949 ts_prof_cas = ts_cas(it_cas2) & 950 &-frac*(ts_cas(it_cas2)-ts_cas(it_cas1))950 -frac*(ts_cas(it_cas2)-ts_cas(it_cas1)) 951 951 ustar_prof_cas = ustar_cas(it_cas2) & 952 &-frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1))952 -frac*(ustar_cas(it_cas2)-ustar_cas(it_cas1)) 953 953 954 954 do k=1,nlev_cas 955 955 plev_prof_cas(k) = plev_cas(k,it_cas2) & 956 &-frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1))956 -frac*(plev_cas(k,it_cas2)-plev_cas(k,it_cas1)) 957 957 t_prof_cas(k) = t_cas(k,it_cas2) & 958 &-frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1))958 -frac*(t_cas(k,it_cas2)-t_cas(k,it_cas1)) 959 959 q_prof_cas(k) = q_cas(k,it_cas2) & 960 &-frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1))960 -frac*(q_cas(k,it_cas2)-q_cas(k,it_cas1)) 961 961 u_prof_cas(k) = u_cas(k,it_cas2) & 962 &-frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1))962 -frac*(u_cas(k,it_cas2)-u_cas(k,it_cas1)) 963 963 v_prof_cas(k) = v_cas(k,it_cas2) & 964 &-frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1))964 -frac*(v_cas(k,it_cas2)-v_cas(k,it_cas1)) 965 965 ug_prof_cas(k) = ug_cas(k,it_cas2) & 966 &-frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1))966 -frac*(ug_cas(k,it_cas2)-ug_cas(k,it_cas1)) 967 967 vg_prof_cas(k) = vg_cas(k,it_cas2) & 968 &-frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1))968 -frac*(vg_cas(k,it_cas2)-vg_cas(k,it_cas1)) 969 969 vitw_prof_cas(k) = vitw_cas(k,it_cas2) & 970 &-frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1))970 -frac*(vitw_cas(k,it_cas2)-vitw_cas(k,it_cas1)) 971 971 du_prof_cas(k) = du_cas(k,it_cas2) & 972 &-frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1))972 -frac*(du_cas(k,it_cas2)-du_cas(k,it_cas1)) 973 973 hu_prof_cas(k) = hu_cas(k,it_cas2) & 974 &-frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1))974 -frac*(hu_cas(k,it_cas2)-hu_cas(k,it_cas1)) 975 975 vu_prof_cas(k) = vu_cas(k,it_cas2) & 976 &-frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1))976 -frac*(vu_cas(k,it_cas2)-vu_cas(k,it_cas1)) 977 977 dv_prof_cas(k) = dv_cas(k,it_cas2) & 978 &-frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1))978 -frac*(dv_cas(k,it_cas2)-dv_cas(k,it_cas1)) 979 979 hv_prof_cas(k) = hv_cas(k,it_cas2) & 980 &-frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1))980 -frac*(hv_cas(k,it_cas2)-hv_cas(k,it_cas1)) 981 981 vv_prof_cas(k) = vv_cas(k,it_cas2) & 982 &-frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1))982 -frac*(vv_cas(k,it_cas2)-vv_cas(k,it_cas1)) 983 983 dt_prof_cas(k) = dt_cas(k,it_cas2) & 984 &-frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1))984 -frac*(dt_cas(k,it_cas2)-dt_cas(k,it_cas1)) 985 985 ht_prof_cas(k) = ht_cas(k,it_cas2) & 986 &-frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1))986 -frac*(ht_cas(k,it_cas2)-ht_cas(k,it_cas1)) 987 987 vt_prof_cas(k) = vt_cas(k,it_cas2) & 988 &-frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1))988 -frac*(vt_cas(k,it_cas2)-vt_cas(k,it_cas1)) 989 989 dtrad_prof_cas(k) = dtrad_cas(k,it_cas2) & 990 &-frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1))990 -frac*(dtrad_cas(k,it_cas2)-dtrad_cas(k,it_cas1)) 991 991 dq_prof_cas(k) = dq_cas(k,it_cas2) & 992 &-frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1))992 -frac*(dq_cas(k,it_cas2)-dq_cas(k,it_cas1)) 993 993 hq_prof_cas(k) = hq_cas(k,it_cas2) & 994 &-frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1))994 -frac*(hq_cas(k,it_cas2)-hq_cas(k,it_cas1)) 995 995 vq_prof_cas(k) = vq_cas(k,it_cas2) & 996 &-frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1))996 -frac*(vq_cas(k,it_cas2)-vq_cas(k,it_cas1)) 997 997 uw_prof_cas(k) = uw_cas(k,it_cas2) & 998 &-frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1))998 -frac*(uw_cas(k,it_cas2)-uw_cas(k,it_cas1)) 999 999 vw_prof_cas(k) = vw_cas(k,it_cas2) & 1000 &-frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1))1000 -frac*(vw_cas(k,it_cas2)-vw_cas(k,it_cas1)) 1001 1001 q1_prof_cas(k) = q1_cas(k,it_cas2) & 1002 &-frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1))1002 -frac*(q1_cas(k,it_cas2)-q1_cas(k,it_cas1)) 1003 1003 q2_prof_cas(k) = q2_cas(k,it_cas2) & 1004 &-frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1))1004 -frac*(q2_cas(k,it_cas2)-q2_cas(k,it_cas1)) 1005 1005 enddo 1006 1006 -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_lmdz1d.F90
r5075 r5087 458 458 type_ts_forcing = 0 459 459 if (forcing_toga.or.forcing_sandu.or.forcing_astex .or. forcing_dice) & 460 &type_ts_forcing = 1460 type_ts_forcing = 1 461 461 ! 462 462 ! Initialization of the logical switch for nudging … … 549 549 ! Convert the initial date of Toga-Coare to Julian day 550 550 call ymds2ju & 551 &(year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)551 (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga) 552 552 553 553 ELSEIF (forcing_type ==4) THEN 554 554 ! Convert the initial date of TWPICE to Julian day 555 555 call ymds2ju & 556 &(year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi &557 &,day_ju_ini_twpi)556 (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi & 557 ,day_ju_ini_twpi) 558 558 ELSEIF (forcing_type ==6) THEN 559 559 ! Convert the initial date of AMMA to Julian day 560 560 call ymds2ju & 561 &(year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma &562 &,day_ju_ini_amma)561 (year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma & 562 ,day_ju_ini_amma) 563 563 ELSEIF (forcing_type ==7) THEN 564 564 ! Convert the initial date of DICE to Julian day 565 565 call ymds2ju & 566 & (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice &567 &,day_ju_ini_dice)566 (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice & 567 ,day_ju_ini_dice) 568 568 ELSEIF (forcing_type ==8 ) THEN 569 569 ! Convert the initial date of GABLS4 to Julian day 570 570 call ymds2ju & 571 & (year_ini_gabls4,mth_ini_gabls4,day_ini_gabls4,heure_ini_gabls4 &572 &,day_ju_ini_gabls4)571 (year_ini_gabls4,mth_ini_gabls4,day_ini_gabls4,heure_ini_gabls4 & 572 ,day_ju_ini_gabls4) 573 573 ELSEIF (forcing_type >100) THEN 574 574 ! Convert the initial date to Julian day … … 576 576 print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas 577 577 call ymds2ju & 578 &(year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600 &579 &,day_ju_ini_cas)578 (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600 & 579 ,day_ju_ini_cas) 580 580 print*,'time case 2',day_ini_cas,day_ju_ini_cas 581 581 ELSEIF (forcing_type ==59) THEN 582 582 ! Convert the initial date of Sandu case to Julian day 583 583 call ymds2ju & 584 &(year_ini_sandu,mth_ini_sandu,day_ini_sandu, &585 &time_ini*3600.,day_ju_ini_sandu)584 (year_ini_sandu,mth_ini_sandu,day_ini_sandu, & 585 time_ini*3600.,day_ju_ini_sandu) 586 586 587 587 ELSEIF (forcing_type ==60) THEN 588 588 ! Convert the initial date of Astex case to Julian day 589 589 call ymds2ju & 590 &(year_ini_astex,mth_ini_astex,day_ini_astex, &591 &time_ini*3600.,day_ju_ini_astex)590 (year_ini_astex,mth_ini_astex,day_ini_astex, & 591 time_ini*3600.,day_ju_ini_astex) 592 592 593 593 ELSEIF (forcing_type ==61) THEN 594 594 ! Convert the initial date of Arm_cu case to Julian day 595 595 call ymds2ju & 596 &(year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu &597 &,day_ju_ini_armcu)596 (year_ini_armcu,mth_ini_armcu,day_ini_armcu,heure_ini_armcu & 597 ,day_ju_ini_armcu) 598 598 ENDIF 599 599 … … 606 606 call ju2ymds(daytime,year_print, month_print,day_print,sec_print) 607 607 print *,' Time of beginning : ', & 608 &year_print, month_print, day_print, sec_print608 year_print, month_print, day_print, sec_print 609 609 610 610 !--------------------------------------------------------------------- … … 852 852 853 853 print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf & 854 &,pctsrf(1,is_oce),pctsrf(1,is_ter)854 ,pctsrf(1,is_oce),pctsrf(1,is_ter) 855 855 856 856 zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic) … … 989 989 ! fabrication de limit.nc 990 990 call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug, & 991 &phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)991 phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic) 992 992 993 993 … … 997 997 print*,'call to restart dyn 1d' 998 998 Call dyn1deta0("start1dyn.nc",plev,play,phi,phis,presnivs, & 999 &u,v,temp,q,omega2)999 u,v,temp,q,omega2) 1000 1000 1001 1001 print*,'fnday,annee_ref,day_ref,day_ini', & 1002 &fnday,annee_ref,day_ref,day_ini1002 fnday,annee_ref,day_ref,day_ini 1003 1003 !** call ymds2ju(annee_ref,mois,day_ini,heure,day) 1004 1004 day = day_ini … … 1052 1052 if (prt_level>=1) then 1053 1053 print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', & 1054 &it,day,time,it_end,day_step1054 it,day,time,it_end,day_step 1055 1055 print*,'PAS DE TEMPS ',timestep 1056 1056 endif … … 1065 1065 do l = 1, llm-1 1066 1066 phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))* & 1067 &(play(l)-play(l+1))/(play(l)+play(l+1))1067 (play(l)-play(l+1))/(play(l)+play(l+1)) 1068 1068 enddo 1069 1069 … … 1095 1095 print *,' avant physiq : -------- day time ',day,time 1096 1096 write(*,*) 'firstcall,lastcall,phis', & 1097 &firstcall,lastcall,phis1097 firstcall,lastcall,phis 1098 1098 end if 1099 1099 if (prt_level>=5) then 1100 1100 write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l', & 1101 &'presniv','plev','play','phi'1101 'presniv','plev','play','phi' 1102 1102 write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l, & 1103 &presnivs(l),plev(l),play(l),phi(l),l=1,llm)1103 presnivs(l),plev(l),play(l),phi(l),l=1,llm) 1104 1104 write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l', & 1105 &'presniv','u','v','temp','q1','q2','omega2'1105 'presniv','u','v','temp','q1','q2','omega2' 1106 1106 write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l, & 1107 &presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)1107 presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm) 1108 1108 endif 1109 1109 … … 1123 1123 if (prt_level>=5) then 1124 1124 write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l', & 1125 &'presniv','plev','play','phi'1125 'presniv','plev','play','phi' 1126 1126 write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l, & 1127 &presnivs(l),plev(l),play(l),phi(l),l=1,llm)1127 presnivs(l),plev(l),play(l),phi(l),l=1,llm) 1128 1128 write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l', & 1129 &'presniv','u','v','temp','q1','q2','omega2'1129 'presniv','u','v','temp','q1','q2','omega2' 1130 1130 write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l, & 1131 &presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)1131 presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm) 1132 1132 write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l', & 1133 & 'presniv','du_phys','dv_phys','dt_phys','dq1','dq2'1133 'presniv','du_phys','dv_phys','dt_phys','dq1','dq2' 1134 1134 write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l, & 1135 &presnivs(l),86400*du_phys(l),86400*dv_phys(l), &1136 &86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm)1135 presnivs(l),86400*du_phys(l),86400*dv_phys(l), & 1136 86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm) 1137 1137 write(*,*) 'dpsrf',dpsrf 1138 1138 endif … … 1151 1151 1152 1152 if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice & 1153 &.or.forcing_amma .or. forcing_type==101) then1153 .or.forcing_amma .or. forcing_type==101) then 1154 1154 fcoriolis=0.0 ; ug=0. ; vg=0. 1155 1155 endif … … 1198 1198 ! 1199 1199 du_age(1:mxcalc)= -2.*sfdt/timestep* & 1200 &(sfdt*(u(1:mxcalc)-ug(1:mxcalc)) - &1201 &cfdt*(v(1:mxcalc)-vg(1:mxcalc)) )1200 (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) - & 1201 cfdt*(v(1:mxcalc)-vg(1:mxcalc)) ) 1202 1202 !! : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc)) 1203 1203 ! 1204 1204 dv_age(1:mxcalc)= -2.*sfdt/timestep* & 1205 &(cfdt*(u(1:mxcalc)-ug(1:mxcalc)) + &1206 &sfdt*(v(1:mxcalc)-vg(1:mxcalc)) )1205 (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) + & 1206 sfdt*(v(1:mxcalc)-vg(1:mxcalc)) ) 1207 1207 !! : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc)) 1208 1208 ! … … 1216 1216 if (nudge(inudge_RHT)) then 1217 1217 call nudge_RHT(timestep,plev,play,t_targ,rh_targ,temp,q(:,1), & 1218 &d_t_nudge,d_q_nudge(:,1))1218 d_t_nudge,d_q_nudge(:,1)) 1219 1219 endif 1220 1220 if (nudge(inudge_UV)) then 1221 1221 call nudge_UV(timestep,plev,play,u_targ,v_targ,u,v, & 1222 &d_u_nudge,d_v_nudge)1222 d_u_nudge,d_v_nudge) 1223 1223 endif 1224 1224 ! … … 1263 1263 else 1264 1264 u(1:mxcalc)=u(1:mxcalc) + timestep*( & 1265 &du_phys(1:mxcalc) &1266 &+du_age(1:mxcalc)+du_adv(1:mxcalc) &1267 & +d_u_nudge(1:mxcalc) )1265 du_phys(1:mxcalc) & 1266 +du_age(1:mxcalc)+du_adv(1:mxcalc) & 1267 +d_u_nudge(1:mxcalc) ) 1268 1268 v(1:mxcalc)=v(1:mxcalc) + timestep*( & 1269 &dv_phys(1:mxcalc) &1270 &+dv_age(1:mxcalc)+dv_adv(1:mxcalc) &1271 &+d_v_nudge(1:mxcalc) )1269 dv_phys(1:mxcalc) & 1270 +dv_age(1:mxcalc)+dv_adv(1:mxcalc) & 1271 +d_v_nudge(1:mxcalc) ) 1272 1272 q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*( & 1273 &dq(1:mxcalc,:) &1274 &+d_q_adv(1:mxcalc,:) &1275 &+d_q_nudge(1:mxcalc,:) )1273 dq(1:mxcalc,:) & 1274 +d_q_adv(1:mxcalc,:) & 1275 +d_q_nudge(1:mxcalc,:) ) 1276 1276 1277 1277 if (prt_level>=3) then 1278 1278 print *, & 1279 &'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &1280 &temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1)1279 'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', & 1280 temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) 1281 1281 print* ,'dv_phys=',dv_phys 1282 1282 print* ,'dv_age=',dv_age … … 1288 1288 1289 1289 temp(1:mxcalc)=temp(1:mxcalc)+timestep*( & 1290 &dt_phys(1:mxcalc) &1291 &+d_t_adv(1:mxcalc) &1292 &+d_t_nudge(1:mxcalc) &1293 &+dt_cooling(1:mxcalc)) ! Taux de chauffage ou refroid.1290 dt_phys(1:mxcalc) & 1291 +d_t_adv(1:mxcalc) & 1292 +d_t_nudge(1:mxcalc) & 1293 +dt_cooling(1:mxcalc)) ! Taux de chauffage ou refroid. 1294 1294 1295 1295 #ifdef OUTPUT_PHYS_SCM … … 1308 1308 IF (nudge_tsoil .AND. .NOT. lastcall) THEN 1309 1309 ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:) & 1310 &-timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)1310 -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge) 1311 1311 ENDIF 1312 1312 … … 1358 1358 ! ------------------------------------- 1359 1359 call dyn1dredem("restart1dyn.nc", & 1360 &plev,play,phi,phis,presnivs, &1361 &u,v,temp,q,omega2)1360 plev,play,phi,phis,presnivs, & 1361 u,v,temp,q,omega2) 1362 1362 1363 1363 CALL abort_gcm ('lmdz1d ','The End ',0) -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90
r5082 r5087 143 143 144 144 IF(ngrid/=2+(jm-2)*(im-1).AND.ngrid/=1) & 145 &STOP 'probleme de dim'145 STOP 'probleme de dim' 146 146 ! traitement des poles 147 147 CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid) -
LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/scm.F90
r5082 r5087 376 376 print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas 377 377 call ymds2ju & 378 &(year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600 &379 &,day_ju_ini_cas)378 (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600 & 379 ,day_ju_ini_cas) 380 380 print*,'time case 2',day_ini_cas,day_ju_ini_cas 381 381 daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation … … 384 384 call ju2ymds(daytime,year_print, month_print,day_print,sec_print) 385 385 print *,' Time of beginning : ', & 386 &year_print, month_print, day_print, sec_print386 year_print, month_print, day_print, sec_print 387 387 388 388 !--------------------------------------------------------------------- … … 615 615 616 616 print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf & 617 &,pctsrf(1,is_oce),pctsrf(1,is_ter)617 ,pctsrf(1,is_oce),pctsrf(1,is_ter) 618 618 619 619 zmasq=pctsrf(1,is_ter)+pctsrf(1,is_lic) … … 746 746 ! fabrication de limit.nc 747 747 call writelim (1,phy_nat,phy_alb,phy_sst,phy_bil,phy_rug, & 748 &phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic)748 phy_ice,phy_fter,phy_foce,phy_flic,phy_fsic) 749 749 750 750 … … 754 754 print*,'call to restart dyn 1d' 755 755 Call dyn1deta0("start1dyn.nc",plev,play,phi,phis,presnivs, & 756 &u,v,temp,q,omega2)756 u,v,temp,q,omega2) 757 757 758 758 print*,'fnday,annee_ref,day_ref,day_ini', & 759 &fnday,annee_ref,day_ref,day_ini759 fnday,annee_ref,day_ref,day_ini 760 760 !** call ymds2ju(annee_ref,mois,day_ini,heure,day) 761 761 day = day_ini … … 800 800 if (prt_level>=1) then 801 801 print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=', & 802 &it,day,time,it_end,day_step802 it,day,time,it_end,day_step 803 803 print*,'PAS DE TEMPS ',timestep 804 804 endif … … 822 822 do l = 1, llm-1 823 823 phi(l+1)=phi(l)+RD*(temp(l)+temp(l+1))* & 824 &(play(l)-play(l+1))/(play(l)+play(l+1))824 (play(l)-play(l+1))/(play(l)+play(l+1)) 825 825 enddo 826 826 … … 861 861 print *,' avant physiq : -------- day time ',day,time 862 862 write(*,*) 'firstcall,lastcall,phis', & 863 &firstcall,lastcall,phis863 firstcall,lastcall,phis 864 864 end if 865 865 if (prt_level>=5) then 866 866 write(*,'(a10,2a4,4a13)') 'BEFOR1 IT=','it','l', & 867 &'presniv','plev','play','phi'867 'presniv','plev','play','phi' 868 868 write(*,'(a10,2i4,4f13.2)') ('BEFOR1 IT= ',it,l, & 869 &presnivs(l),plev(l),play(l),phi(l),l=1,llm)869 presnivs(l),plev(l),play(l),phi(l),l=1,llm) 870 870 write(*,'(a11,2a4,a11,6a8)') 'BEFOR2','it','l', & 871 &'presniv','u','v','temp','q1','q2','omega2'871 'presniv','u','v','temp','q1','q2','omega2' 872 872 write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('BEFOR2 IT= ',it,l, & 873 &presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)873 presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm) 874 874 endif 875 875 … … 889 889 if (prt_level>=5) then 890 890 write(*,'(a11,2a4,4a13)') 'AFTER1 IT=','it','l', & 891 &'presniv','plev','play','phi'891 'presniv','plev','play','phi' 892 892 write(*,'(a11,2i4,4f13.2)') ('AFTER1 it= ',it,l, & 893 &presnivs(l),plev(l),play(l),phi(l),l=1,llm)893 presnivs(l),plev(l),play(l),phi(l),l=1,llm) 894 894 write(*,'(a11,2a4,a11,6a8)') 'AFTER2','it','l', & 895 &'presniv','u','v','temp','q1','q2','omega2'895 'presniv','u','v','temp','q1','q2','omega2' 896 896 write(*,'(a11,2i4,f11.2,5f8.2,e10.2)') ('AFTER2 it= ',it,l, & 897 &presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm)897 presnivs(l),u(l),v(l),temp(l),q(l,1),q(l,2),omega2(l),l=1,llm) 898 898 write(*,'(a11,2a4,a11,5a8)') 'AFTER3','it','l', & 899 & 'presniv','du_phys','dv_phys','dt_phys','dq1','dq2'899 'presniv','du_phys','dv_phys','dt_phys','dq1','dq2' 900 900 write(*,'(a11,2i4,f11.2,5f8.2)') ('AFTER3 it= ',it,l, & 901 &presnivs(l),86400*du_phys(l),86400*dv_phys(l), &902 &86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm)901 presnivs(l),86400*du_phys(l),86400*dv_phys(l), & 902 86400*dt_phys(l),86400*dq(l,1),dq(l,2),l=1,llm) 903 903 write(*,*) 'dpsrf',dpsrf 904 904 endif … … 924 924 925 925 d_u_age(1:mxcalc)= -2.*sfdt/timestep* & 926 &(sfdt*(u(1:mxcalc)-ug(1:mxcalc)) - &927 &cfdt*(v(1:mxcalc)-vg(1:mxcalc)) )926 (sfdt*(u(1:mxcalc)-ug(1:mxcalc)) - & 927 cfdt*(v(1:mxcalc)-vg(1:mxcalc)) ) 928 928 !! : fcoriolis*(v(1:mxcalc)-vg(1:mxcalc)) 929 929 ! 930 930 d_v_age(1:mxcalc)= -2.*sfdt/timestep* & 931 &(cfdt*(u(1:mxcalc)-ug(1:mxcalc)) + &932 &sfdt*(v(1:mxcalc)-vg(1:mxcalc)) )931 (cfdt*(u(1:mxcalc)-ug(1:mxcalc)) + & 932 sfdt*(v(1:mxcalc)-vg(1:mxcalc)) ) 933 933 !! : -fcoriolis*(u(1:mxcalc)-ug(1:mxcalc)) 934 934 ENDIF … … 953 953 954 954 IF ( play(l) < p_nudging_u .AND. nint(nudging_u) /= 0 ) & 955 &d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))/nudging_u955 d_u_nudge(l)=(u_nudg_mod_cas(l)-u(l))/nudging_u 956 956 957 957 ENDIF … … 966 966 967 967 IF ( play(l) < p_nudging_v .AND. nint(nudging_v) /= 0 ) & 968 &d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))/nudging_v968 d_v_nudge(l)=(v_nudg_mod_cas(l)-v(l))/nudging_v 969 969 970 970 ENDIF … … 979 979 980 980 IF ( play(l) < p_nudging_t .AND. nint(nudging_t) /= 0 ) & 981 &d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))/nudging_t981 d_t_nudge(l)=(temp_nudg_mod_cas(l)-temp(l))/nudging_t 982 982 983 983 ENDIF … … 991 991 992 992 IF ( play(l) < p_nudging_qv .AND. nint(nudging_qv) /= 0 ) & 993 &d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))/nudging_qv993 d_q_nudge(l,1)=(qv_nudg_mod_cas(l)-q(l,1))/nudging_qv 994 994 995 995 ENDIF … … 1021 1021 1022 1022 u(1:mxcalc)=u(1:mxcalc) + timestep*( & 1023 &du_phys(1:mxcalc) &1024 &+d_u_age(1:mxcalc)+d_u_adv(1:mxcalc) &1025 & +d_u_nudge(1:mxcalc) )1023 du_phys(1:mxcalc) & 1024 +d_u_age(1:mxcalc)+d_u_adv(1:mxcalc) & 1025 +d_u_nudge(1:mxcalc) ) 1026 1026 v(1:mxcalc)=v(1:mxcalc) + timestep*( & 1027 &dv_phys(1:mxcalc) &1028 &+d_v_age(1:mxcalc)+d_v_adv(1:mxcalc) &1029 &+d_v_nudge(1:mxcalc) )1027 dv_phys(1:mxcalc) & 1028 +d_v_age(1:mxcalc)+d_v_adv(1:mxcalc) & 1029 +d_v_nudge(1:mxcalc) ) 1030 1030 q(1:mxcalc,:)=q(1:mxcalc,:)+timestep*( & 1031 &dq(1:mxcalc,:) &1032 &+d_q_adv(1:mxcalc,:) &1033 &+d_q_nudge(1:mxcalc,:) )1031 dq(1:mxcalc,:) & 1032 +d_q_adv(1:mxcalc,:) & 1033 +d_q_nudge(1:mxcalc,:) ) 1034 1034 1035 1035 if (prt_level>=3) then 1036 1036 print *, & 1037 &'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', &1038 &temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1)1037 'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ', & 1038 temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) 1039 1039 print* ,'dv_phys=',dv_phys 1040 1040 print* ,'d_v_age=',d_v_age … … 1046 1046 1047 1047 temp(1:mxcalc)=temp(1:mxcalc)+timestep*( & 1048 &dt_phys(1:mxcalc) &1049 &+d_t_adv(1:mxcalc) &1050 &+d_t_nudge(1:mxcalc) &1051 &+dt_cooling(1:mxcalc)) ! Taux de chauffage ou refroid.1048 dt_phys(1:mxcalc) & 1049 +d_t_adv(1:mxcalc) & 1050 +d_t_nudge(1:mxcalc) & 1051 +dt_cooling(1:mxcalc)) ! Taux de chauffage ou refroid. 1052 1052 1053 1053 … … 1064 1064 IF (nudge_tsoil .AND. .NOT. lastcall) THEN 1065 1065 ftsoil(1,isoil_nudge,:) = ftsoil(1,isoil_nudge,:) & 1066 &-timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge)1066 -timestep/tau_soil_nudge*(ftsoil(1,isoil_nudge,:)-Tsoil_nudge) 1067 1067 ENDIF 1068 1068 … … 1110 1110 ! --------------------------------------------------------------------------- 1111 1111 call dyn1dredem("restart1dyn.nc", & 1112 &plev,play,phi,phis,presnivs, &1113 &u,v,temp,q,omega2)1112 plev,play,phi,phis,presnivs, & 1113 u,v,temp,q,omega2) 1114 1114 1115 1115 CALL abort_gcm ('lmdz1d ','The End ',0)
Note: See TracChangeset
for help on using the changeset viewer.