Changeset 3336 for trunk/LMDZ.MARS/libf

Timestamp:

May 21, 2024, 1:32:02 PM (7 months ago)

Author:

jbclement

Message:

Mars PCM:
Addition of the paleoclimate variables in the change the number of slopes by "newtart.F" + some simplifications of the way it is done.
JBC

Location:

trunk/LMDZ.MARS/libf

Files:

• dynphy_lonlat/phymars/newstart.F (modified) (9 diffs)
• phymars/paleoclimate_mod.F90 (modified) (1 diff)

trunk/LMDZ.MARS/libf/dynphy_lonlat/phymars/newstart.F

@@ -58 +58 @@
       use comslope_mod, ONLY: nslope,def_slope,def_slope_mean,
      &             subslope_dist,end_comslope_h,ini_comslope_h
-      USE subslope_mola_mod, ONLY: subslope_mola
+      use paleoclimate_mod, only: h2o_ice_depth, lag_co2_ice, d_coef,
+     &             ini_paleoclimate_h, end_paleoclimate_h
+      use subslope_mola_mod, ONLY: subslope_mola
       
       implicit none
@@ -192 +194 @@
 ! sub-grid cloud fraction
       real :: totcloudfrac(ngridmx)
-!Variable to change the number of subslope
-      REAL, ALLOCATABLE :: default_def_slope(:)
-      REAL,ALLOCATABLE :: tsurf_old_slope(:,:)   ! Surface temperature (K)
-      REAL,ALLOCATABLE :: emis_old_slope(:,:)    ! Thermal IR surface emissivity
-      REAL,ALLOCATABLE :: qsurf_old_slope(:,:,:) ! tracer on surface (e.g. kg.m-2)
-      REAL,ALLOCATABLE :: watercap_old_slope(:,:) ! Surface water ice (kg.m-2)
-      REAL,ALLOCATABLE :: perennial_co2_old_slope(:,:) ! Surface water ice (kg.m-2)
-      REAL,ALLOCATABLE :: tsoil_old_slope(:,:,:) 
-      REAL,ALLOCATABLE :: inertiesoil_old_slope(:,:,:) 
-      REAL,ALLOCATABLE :: albedo_old_slope(:,:,:) ! Surface albedo in each solar band
-      REAL,ALLOCATABLE :: flux_geo_old_slope(:,:)
-      integer :: iflat
-      integer :: nslope_old, nslope_new
+! Variables to change the number of subslope
+      real, allocatable, dimension(:)     :: default_def_slope
+      real, allocatable, dimension(:,:)   :: tsurf_old_slope         ! Surface temperature (K)
+      real, allocatable, dimension(:,:)   :: emis_old_slope          ! Thermal IR surface emissivity
+      real, allocatable, dimension(:,:,:) :: qsurf_old_slope         ! tracer on surface (e.g. kg.m-2)
+      real, allocatable, dimension(:,:)   :: watercap_old_slope      ! Surface water ice (kg.m-2)
+      real, allocatable, dimension(:,:)   :: perennial_co2_old_slope ! Surface water ice (kg.m-2)
+      real, allocatable, dimension(:,:,:) :: tsoil_old_slope
+      real, allocatable, dimension(:,:,:) :: inertiesoil_old_slope
+      real, allocatable, dimension(:,:,:) :: albedo_old_slope        ! Surface albedo in each solar band
+      real, allocatable, dimension(:,:)   :: flux_geo_old_slope
+      real, allocatable, dimension(:,:)   :: h2o_ice_depth_old_slope
+      real, allocatable, dimension(:,:)   :: lag_co2_ice_old_slope
+      real, allocatable, dimension(:,:)   :: d_coef_old_slope
+      integer :: iflat, nslope_old, nslope_new
 
 
@@ -1735 +1739 @@
           write(*,*) 'set a new number of subgrid scale slopes'
           write(*,*) 'Current value=', nslope
-          write(*,*) 'Enter value for nslope (ex: 1,5,7)?'
+          write(*,*) 'Enter value for nslope (ex: 1,3,5,7)?'
           ierr=1
           do while (ierr.ne.0)
@@ -1744 +1748 @@
        write(*,*) 'You can go grab a coffee and relax a bit'
 
-      if(nslope.eq.nslope_new) then
+      if (nslope == nslope_new) then
         write(*,*) 'The number of subslope you entered is the same' 
         write(*,*) 'as the number written in startfi.nc. '
@@ -1798 +1802 @@
 
        iflat = 1
-       DO islope=2,nslope_new
-         IF(abs(def_slope_mean(islope)).lt.
-     &      abs(def_slope_mean(iflat)))THEN
+       do islope = 2,nslope_new
+         if (abs(def_slope_mean(islope)) <
+     &      abs(def_slope_mean(iflat))) then
            iflat = islope
-         ENDIF
-       ENDDO
+         endif
+       enddo
 
        if (ngridmx /= 1) then
@@ -1815 +1819 @@
         allocate(watercap_old_slope(ngridmx,nslope_old)) 
         allocate(perennial_co2_old_slope(ngridmx,nslope_old)) 
-
         tsurf_old_slope(:,:)=tsurf(:,:)
         qsurf_old_slope(:,:,:)=qsurf(:,:,:)
@@ -1828 +1831 @@
         allocate(inertiesoil_old_slope(ngridmx,nsoilmx,nslope_old))
         allocate(flux_geo_old_slope(ngridmx,nslope_old))
-
         inertiesoil_old_slope(:,:,:)=inertiesoil(:,:,:)
         tsoil_old_slope(:,:,:)=tsoil(:,:,:)
         flux_geo_old_slope(:,:)=flux_geo(:,:)
-
         call end_comsoil_h_slope_var
         call ini_comsoil_h_slope_var(ngridmx,nslope_new)
@@ -1839 +1840 @@
         allocate(albedo_old_slope(ngridmx,2,nslope_old))
         albedo_old_slope(:,:,:)=albedo(:,:,:)
-
         call end_dimradmars_mod_slope_var
         call ini_dimradmars_mod_slope_var(ngridmx,nslope_new)
 
-        if(nslope_old.eq.1 .and. nslope_new.gt.1) then
-          do islope=1,nslope_new
-             tsurf(:,islope)=tsurf_old_slope(:,1)
-             qsurf(:,:,islope)=qsurf_old_slope(:,:,1)
-             emis(:,islope)=emis_old_slope(:,1)
-             watercap(:,islope)=watercap_old_slope(:,1)
-             perennial_co2ice(:,islope)= perennial_co2_old_slope(:,1)
-             tsoil(:,:,islope)=tsoil_old_slope(:,:,1)
-             albedo(:,:,islope)=albedo_old_slope(:,:,1)
-             inertiesoil(:,:,islope)=inertiesoil_old_slope(:,:,1)
-             flux_geo(:,islope)=flux_geo_old_slope(:,1)
-          enddo
-        elseif(nslope_new.eq.1) then
-             tsurf(:,1)=tsurf_old_slope(:,iflat)
-             qsurf(:,:,1)=qsurf_old_slope(:,:,iflat)
-             emis(:,1)=emis_old_slope(:,iflat)
-             watercap(:,1)=watercap_old_slope(:,iflat)
-             perennial_co2ice(:,islope)= 
-     &                 perennial_co2_old_slope(:,iflat)
-             tsoil(:,:,1)=tsoil_old_slope(:,:,iflat)
-             albedo(:,:,1)=albedo_old_slope(:,:,iflat)
-             inertiesoil(:,:,1)=inertiesoil_old_slope(:,:,iflat)
-             flux_geo(:,1)=flux_geo_old_slope(:,iflat)
-        elseif(nslope_old.eq.5 .and. nslope_new.eq.7) then
-          do islope=1,nslope_new
-             tsurf(:,islope)=tsurf_old_slope(:,iflat)
-             qsurf(:,:,islope)=qsurf_old_slope(:,:,iflat)
-             emis(:,islope)=emis_old_slope(:,iflat)
-             watercap(:,islope)=watercap_old_slope(:,iflat)
-             perennial_co2ice(:,islope)= 
-     &                 perennial_co2_old_slope(:,iflat)
-             tsoil(:,:,islope)=tsoil_old_slope(:,:,iflat)
-             albedo(:,:,islope)=albedo_old_slope(:,:,iflat)
-             inertiesoil(:,:,islope)=inertiesoil_old_slope(:,:,iflat)
-             flux_geo(:,islope)=flux_geo_old_slope(:,iflat)
-          enddo
-        elseif(nslope_old.eq.7 .and. nslope_new.eq.5) then
-          do islope=1,nslope_new
-             tsurf(:,islope)=tsurf_old_slope(:,iflat)
-             qsurf(:,:,islope)=qsurf_old_slope(:,:,iflat)
-             emis(:,islope)=emis_old_slope(:,iflat)
-             watercap(:,islope)=watercap_old_slope(:,iflat)
-             perennial_co2ice(:,islope)= 
-     &                 perennial_co2_old_slope(:,iflat)
-             tsoil(:,:,islope)=tsoil_old_slope(:,:,iflat)
-             albedo(:,:,islope)=albedo_old_slope(:,:,iflat)
-             inertiesoil(:,:,islope)=inertiesoil_old_slope(:,:,iflat)
-             flux_geo(:,islope)=flux_geo_old_slope(:,iflat)
+! Paleoclimate related stuff
+        allocate(h2o_ice_depth_old_slope(ngridmx,nslope_old))
+        allocate(lag_co2_ice_old_slope(ngridmx,nslope_old))
+        allocate(d_coef_old_slope(ngridmx,nslope_old))
+        h2o_ice_depth_old_slope = h2o_ice_depth
+        lag_co2_ice_old_slope = lag_co2_ice
+        d_coef_old_slope = d_coef
+        call end_paleoclimate_h
+        call ini_paleoclimate_h(ngridmx,nslope_new)
+
+! Update of the variables with the new "slopes" situation according to the old one
+        if (nslope_old == 1) then
+          do islope = 1,nslope_new
+             tsurf(:,islope) = tsurf_old_slope(:,1)
+             qsurf(:,:,islope) = qsurf_old_slope(:,:,1)
+             emis(:,islope) = emis_old_slope(:,1)
+             watercap(:,islope) = watercap_old_slope(:,1)
+             perennial_co2ice(:,islope) =
+     &                                     perennial_co2_old_slope(:,1)
+             tsoil(:,:,islope) = tsoil_old_slope(:,:,1)
+             albedo(:,:,islope) = albedo_old_slope(:,:,1)
+             inertiesoil(:,:,islope) = inertiesoil_old_slope(:,:,1)
+             flux_geo(:,islope) = flux_geo_old_slope(:,1)
+             h2o_ice_depth(:,islope) = h2o_ice_depth_old_slope(:,1)
+             lag_co2_ice(:,islope) = lag_co2_ice_old_slope(:,1)
+             d_coef(:,islope) = d_coef_old_slope(:,1)
           enddo
         else
-          write(*,*)' Problem choice of nslope'
-          write(*,*)' Value not taken into account'
-          CALL ABORT
+          do islope = 1,nslope_new
+             tsurf(:,islope) = tsurf_old_slope(:,iflat)
+             qsurf(:,:,islope) = qsurf_old_slope(:,:,iflat)
+             emis(:,islope) = emis_old_slope(:,iflat)
+             watercap(:,islope) = watercap_old_slope(:,iflat)
+             perennial_co2ice(:,islope) =
+     &                                 perennial_co2_old_slope(:,iflat)
+             tsoil(:,:,islope) = tsoil_old_slope(:,:,iflat)
+             albedo(:,:,islope) = albedo_old_slope(:,:,iflat)
+             inertiesoil(:,:,islope) = inertiesoil_old_slope(:,:,iflat)
+             flux_geo(:,islope) = flux_geo_old_slope(:,iflat)
+             h2o_ice_depth(:,islope) = h2o_ice_depth_old_slope(:,iflat)
+             lag_co2_ice(:,islope) = lag_co2_ice_old_slope(:,iflat)
+             d_coef(:,islope) = d_coef_old_slope(:,iflat)
+          enddo
         endif
+
+        deallocate(default_def_slope,tsurf_old_slope,qsurf_old_slope)
+        deallocate(emis_old_slope,watercap_old_slope)
+        deallocate(perennial_co2_old_slope,tsoil_old_slope)
+        deallocate(inertiesoil_old_slope,flux_geo_old_slope)
+        deallocate(albedo_old_slope,h2o_ice_depth_old_slope)
+        deallocate(lag_co2_ice_old_slope,d_coef_old_slope)
 
         endif !nslope=nslope_new
@@ -1902 +1899 @@
         else
           write(*,*) '       Unknown (misspelled?) option!!!'
-        end if ! of if (trim(modif) .eq. '...') elseif ...
+        end if ! of if (trim(modif) == '...') elseif ...
         
        enddo ! of do ! infinite loop on liste of changes

trunk/LMDZ.MARS/libf/phymars/paleoclimate_mod.F90

@@ -15 +15 @@
 
 !$OMP THREADPRIVATE(paleoclimate)
-    real,    save, allocatable, dimension(:,:) :: h2o_ice_depth           ! Thickness of the lag before H2O ice [m]
-    real,    save, allocatable, dimension(:,:) :: lag_co2_ice             ! Thickness of the lag before CO2 ice [m]
-    real,    save, allocatable, dimension(:,:) :: d_coef                  ! Diffusion coeficent
-    real,    save                              :: albedo_perennialco2     ! Albedo for perennial co2 ice [1]
-    logical, save                              :: lag_layer               ! Does lag layer is present?
-    logical, save                              :: include_waterbuoyancy   ! Include the effect of water buoyancy when computing the sublimation of water ice ?
+    real,    save, allocatable, dimension(:,:) :: h2o_ice_depth         ! Thickness of the lag before H2O ice [m]
+    real,    save, allocatable, dimension(:,:) :: lag_co2_ice           ! Thickness of the lag before CO2 ice [m]
+    real,    save, allocatable, dimension(:,:) :: d_coef                ! Diffusion coefficent
+    real,    save                              :: albedo_perennialco2   ! Albedo for perennial co2 ice [1]
+    logical, save                              :: lag_layer             ! Does lag layer is present?
+    logical, save                              :: include_waterbuoyancy ! Include the effect of water buoyancy when computing the sublimation of water ice ?
 !$OMP THREADPRIVATE(h2o_ice_depth,lag_co2_ice,d_coef,albedo_perennialco2,lag_layer,include_waterbuoyancy)