Changeset 2720 for LMDZ5/branches/testing/libf/phylmd/dyn1d/lmdz1d.F90

Timestamp:

Nov 30, 2016, 1:28:41 PM (8 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r2664:2719 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/dyn1d/lmdz1d.F90 (modified) (18 diffs)

LMDZ5/branches/testing/libf/phylmd/dyn1d/lmdz1d.F90

@@ -21 +21 @@
        zgam, zmax0, zmea, zpic, zsig, &
        zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl
+  
    USE dimphy
    USE surface_data, only : type_ocean,ok_veget
@@ -31 +32 @@
    USE indice_sol_mod
    USE phyaqua_mod
-   USE mod_1D_cases_read
+!  USE mod_1D_cases_read
+   USE mod_1D_cases_read2
    USE mod_1D_amma_read
    USE print_control_mod, ONLY: lunout, prt_level
@@ -131 +133 @@
         logical :: forcing_amma    = .false.
         logical :: forcing_dice    = .false.
+        logical :: forcing_gabls4  = .false.
+
         logical :: forcing_GCM2SCM = .false.
         logical :: forcing_GCSSold = .false.
@@ -137 +141 @@
         logical :: forcing_fire    = .false.
         logical :: forcing_case    = .false.
+        logical :: forcing_case2   = .false.
         integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
 !                                                            (cf read_tsurf1d.F)
@@ -174 +179 @@
       real :: pzero=1.e5
       real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
-      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1),poub
+      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1)
 
 !---------------------------------------------------------------------
@@ -189 +194 @@
       real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
       real :: dt_dyn(llm)
-      real :: dt_cooling(llm),d_th_adv(llm),d_t_nudge(llm)
+      real :: dt_cooling(llm),d_t_adv(llm),d_th_adv(llm),d_t_nudge(llm)
       real :: d_u_nudge(llm),d_v_nudge(llm)
       real :: du_adv(llm),dv_adv(llm)
@@ -322 +327 @@
 !             Different stages: soil model alone, atm. model alone
 !             then both models coupled
+!forcing_type = 8 ==> forcing_gabls4 = .true.
+!             initial profiles and large scale forcings in gabls4_driver.nc
 !forcing_type >= 100 ==> forcing_case = .true.
 !             initial profiles and large scale forcings in cas.nc
@@ -327 +334 @@
 !             101=cindynamo
 !             102=bomex
+!forcing_type >= 100 ==> forcing_case2 = .true.
+!             temporary flag while all the 1D cases are not whith the same cas.nc forcing file
+!             103=arm_cu2 ie arm_cu with new forcing format
+!             104=rico2 ie rico with new forcing format
 !forcing_type = 40 ==> forcing_GCSSold = .true.
 !             initial profile from GCSS file
@@ -363 +374 @@
       elseif (forcing_type .eq.7) THEN
        forcing_dice = .true.
+      elseif (forcing_type .eq.8) THEN
+       forcing_gabls4 = .true.
       elseif (forcing_type .eq.101) THEN ! Cindynamo starts 1-10-2011 0h
        forcing_case = .true.
@@ -375 +388 @@
        mth_ini_cas=6
        day_deb=24
+       heure_ini_cas=0.
+       pdt_cas=1800.         ! forcing frequency
+      elseif (forcing_type .eq.103) THEN ! Arm_cu starts 21-6-1997 11h30
+       forcing_case2 = .true.
+       year_ini_cas=1997
+       mth_ini_cas=6
+       day_deb=21
+       heure_ini_cas=11.5
+       pdt_cas=1800.         ! forcing frequency
+      elseif (forcing_type .eq.104) THEN ! rico starts 16-12-2004 0h
+       forcing_case2 = .true.
+       year_ini_cas=2004
+       mth_ini_cas=12
+       day_deb=16
        heure_ini_cas=0.
        pdt_cas=1800.         ! forcing frequency
@@ -449 +476 @@
       endif
       print *,'fnday=',fnday
-
+!     start_time doit etre en FRACTION DE JOUR
       start_time=time_ini/24.
 
 ! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
       IF(forcing_type .EQ. 61) fnday=53100./86400.
+      IF(forcing_type .EQ. 103) fnday=53100./86400.
 ! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
       IF(forcing_type .EQ. 6) fnday=64800./86400.
 !     IF(forcing_type .EQ. 6) fnday=50400./86400.
+ IF(forcing_type .EQ. 8 ) fnday=129600./86400. 
       annee_ref = anneeref
       mois = 1
@@ -487 +516 @@
      & (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice             & 
      & ,day_ju_ini_dice)
+ ELSEIF (forcing_type .eq.8 ) THEN
+! Convert the initial date of GABLS4 to Julian day
+      call ymds2ju                                                         &
+     & (year_ini_gabls4,mth_ini_gabls4,day_ini_gabls4,heure_ini_gabls4     & 
+     & ,day_ju_ini_gabls4)
       ELSEIF (forcing_type .gt.100) THEN
 ! Convert the initial date to Julian day
@@ -492 +526 @@
       print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas
       call ymds2ju                                                         &
-     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas              &
+     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600            &
      & ,day_ju_ini_cas)
       print*,'time case 2',day_ini_cas,day_ju_ini_cas
@@ -514 +548 @@
       ENDIF
 
+      IF (forcing_type .gt.100) THEN
+      daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation 
+      ELSE
       daytime = day + time_ini/24. ! 1st day and initial time of the simulation 
+      ENDIF
 ! Print out the actual date of the beginning of the simulation :
       call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
@@ -699 +737 @@
 
         fder=0.
-        snsrf(1,:)=0.        ! couverture de neige des sous surface
+        snsrf(1,:)=snowmass ! masse de neige des sous surface
         qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
         fevap=0.
         z0m(1,:)=rugos     ! couverture de neige des sous surface
-        z0h(1,:)=rugos     ! couverture de neige des sous surface
+        z0h(1,:)=rugosh    ! couverture de neige des sous surface
         agesno  = xagesno
         tsoil(:,:,:)=tsurf
@@ -726 +764 @@
         print*,'avant phyredem'
         pctsrf(1,:)=0.
-        if (nat_surf.eq.0.) then
+          if (nat_surf.eq.0.) then
           pctsrf(1,is_oce)=1.
           pctsrf(1,is_ter)=0.
-        else
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 1) then 
           pctsrf(1,is_oce)=0.
           pctsrf(1,is_ter)=1.
-        end if
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 2) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=1.
+          pctsrf(1,is_sic)=0.
+        else if (nat_surf .eq. 3) then 
+          pctsrf(1,is_oce)=0.
+          pctsrf(1,is_ter)=0.
+          pctsrf(1,is_lic)=0.
+          pctsrf(1,is_sic)=1.
+
+     end if
+
 
         print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
@@ -1005 +1059 @@
 
        if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
-     &    .or.forcing_amma) then
+     &    .or.forcing_amma .or. forcing_type.eq.101) then
          fcoriolis=0.0 ; ug=0. ; vg=0.
        endif
-         if(forcing_rico) then
+
+       if(forcing_rico) then
           dt_cooling=0.
-        endif
+       endif
 
       IF (prt_level >= 5) print*, 'fcoriolis, xlat,mxcalc ', &
@@ -1172 +1227 @@
 !#endif
 
+