Changeset 5791 for LMDZ6/branches/contrails/libf/phylmd/limit_read_mod.f90

Timestamp:

Jul 28, 2025, 7:23:15 PM (9 days ago)

Author:

aborella

Message:

Merge with trunk r5789

Location:

LMDZ6/branches/contrails

Files:

• . (modified) (1 prop)
• libf/phylmd/limit_read_mod.f90 (modified) (10 diffs)

LMDZ6/branches/contrails/libf/phylmd/limit_read_mod.f90

@@ -21 +21 @@
 !$OMP THREADPRIVATE(albedo)  
   REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: sst
-!$OMP THREADPRIVATE(sst)  
+!$OMP THREADPRIVATE(sst) 
+!GG
+  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: sih
+!$OMP THREADPRIVATE(sih)
+!GG
   LOGICAL,SAVE :: read_continents=.FALSE.
 !$OMP THREADPRIVATE(read_continents) 
@@ -144 +148 @@
   END SUBROUTINE limit_read_sst
 
+!GG
+  SUBROUTINE limit_read_hice(knon, knindex, hice_out)
+!
+! This subroutine returns the sea surface temperature already read from limit.nc.
+!
+    USE dimphy, ONLY : klon
+
+    INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
+    INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
+    REAL, DIMENSION(klon), INTENT(OUT)   :: hice_out
+
+    INTEGER :: i
+
+    DO i = 1, knon
+       hice_out(i) = sih(knindex(i))
+    END DO
+
+  END SUBROUTINE limit_read_hice
+!GG
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !!
@@ -163 +186 @@
     USE mod_grid_phy_lmdz
     USE mod_phys_lmdz_para
-    USE surface_data, ONLY : type_ocean, ok_veget
+    !GG USE surface_data, ONLY : type_ocean, ok_veget
+    USE surface_data, ONLY : type_ocean, ok_veget, iflag_seaice, amax_n, amax_s
+    !GG
     USE netcdf
     USE indice_sol_mod
@@ -203 +228 @@
     REAL, DIMENSION(klon_mpi)                 :: rug_mpi  ! rugosity at global grid
     REAL, DIMENSION(klon_mpi)                 :: alb_mpi  ! albedo at global grid
+!GG
+    REAL, DIMENSION(klon_glo)                 :: sih_glo  ! albedo at global grid
+    REAL, DIMENSION(klon_mpi)                 :: sih_mpi  ! albedo at global grid
+!GG
 
     CHARACTER(len=20)                         :: modname='limit_read_mod'     
@@ -225 +254 @@
        END IF
 
+       !GG
+       IF (iflag_seaice==1) THEN
+             ALLOCATE(sih(klon), stat=ierr)
+             IF (ierr /= 0) CALL abort_physic(modname, 'PB in allocating sih',1)
+       ENDIF
+       !GG
+
        IF ( .NOT. ok_veget ) THEN
           ALLOCATE(rugos(klon), albedo(klon), stat=ierr)
@@ -303 +339 @@
          IF ( type_ocean /= 'couple') THEN                    
              IF (is_omp_master) CALL xios_recv_field("sst_limin",sst_mpi)
+             !GG
+             IF (iflag_seaice == 1) THEN
+               IF (is_omp_master) CALL xios_recv_field("sih_limin",sih_mpi)
+             ENDIF
+             !GG
          ENDIF
        
@@ -312 +353 @@
        IF ( type_ocean /= 'couple') THEN
           CALL Scatter_omp(sst_mpi,sst)
+          !GG
+          IF (iflag_seaice==1) THEN
+            CALL Scatter_omp(sih_mpi,sih)
+          ENDIF
+          !GG
           CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce))
           CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic))
@@ -362 +408 @@
              IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <FSIC>' ,1)
 
+! GG
+! Account for leads
+             IF (iflag_seaice>0) THEN
+               DO ii=1,klon_glo/2
+                 if (pct_glo(ii,is_sic)>amax_n) THEN
+                    pct_glo(ii,is_oce)=pct_glo(ii,is_oce)+(pct_glo(ii,is_sic)-amax_n)
+                    pct_glo(ii,is_sic)=amax_n
+                 end if
+               ENDDO
+               DO ii=klon_glo/2,klon_glo
+               if (pct_glo(ii,is_sic)>amax_s) THEN
+                    pct_glo(ii,is_oce)=pct_glo(ii,is_oce)+(pct_glo(ii,is_sic)-amax_s)
+                    pct_glo(ii,is_sic)=amax_s
+               end if
+               ENDDO
+             ENDIF
+!GG
 
 ! Read land and continentals fraction only if asked for
@@ -394 +457 @@
              ierr = NF90_GET_VAR(nid,nvarid,sst_glo,start,epais)
              IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <SST>',1)
-          
+           !GG 
+             IF (iflag_seaice == 1) THEN
+               ierr = NF90_INQ_VARID(nid, 'HICE', nvarid)
+               IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Le champ <HICE> est absent',1)
+
+               ierr = NF90_GET_VAR(nid,nvarid,sih_glo(:),start,epais)
+               IF (ierr /= NF90_NOERR) CALL abort_physic(modname,'Lecture echouee pour <HICE>' ,1)
+             ENDIF
+            !GG
           END IF
 
@@ -433 +504 @@
        IF ( type_ocean /= 'couple') THEN
           CALL Scatter(sst_glo,sst)
+          !GG
+          IF (iflag_seaice==1) THEN
+             CALL Scatter(sih_glo,sih)
+          END IF
+          !GG
           CALL Scatter(pct_glo(:,is_oce),pctsrf(:,is_oce))
           CALL Scatter(pct_glo(:,is_sic),pctsrf(:,is_sic))