Changeset 5662 for LMDZ6/trunk/libf/phylmdiso/limit_read_mod.F90

Timestamp:

May 20, 2025, 4:24:41 PM (3 weeks ago)

Author:

Laurent Fairhead

Message:

Ajout du modèle thermodynamique de glace de mer interactive améliorant les flux échangés à la surface de la banquise (Doctorat de Nicolas Michalezyk, Contact : Nicolas Michaleyk, Guillaume Gastineau)

File:

• LMDZ6/trunk/libf/phylmdiso/limit_read_mod.F90 (modified) (11 diffs)

LMDZ6/trunk/libf/phylmdiso/limit_read_mod.F90

@@ -22 +22 @@
   REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: sst
 !$OMP THREADPRIVATE(sst)   
+!GG
+  REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: sih
+!$OMP THREADPRIVATE(sih)
+!GG
 #ifdef ISO 
   REAL, ALLOCATABLE, DIMENSION(:),   SAVE, PRIVATE :: tuoce
@@ -254 +258 @@
   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
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !!
@@ -273 +296 @@
     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
@@ -284 +309 @@
     USE phys_cal_mod, ONLY : calend, year_len
     USE print_control_mod, ONLY: lunout, prt_level
-    USE lmdz_XIOS, ONLY: xios_recv_field
+    USE lmdz_xios, ONLY: xios_recv_field, using_xios
     
     IMPLICIT NONE
@@ -319 +344 @@
     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'     
@@ -344 +373 @@
        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)
@@ -422 +458 @@
          IF ( type_ocean /= 'couple') THEN                    
              IF (is_omp_master) CALL xios_recv_field("sst_limin",sst_mpi)
+             !GG
+             IF (is_omp_master) CALL xios_recv_field("sih_limin",sih_mpi)
+             !GG
          ENDIF
        
@@ -431 +470 @@
        IF ( type_ocean /= 'couple') THEN
           CALL Scatter_omp(sst_mpi,sst)
+          !GG
+          CALL Scatter_omp(sih_mpi,sih)
+          !GG
           CALL Scatter_omp(pct_mpi(:,is_oce),pctsrf(:,is_oce))
           CALL Scatter_omp(pct_mpi(:,is_sic),pctsrf(:,is_sic))
@@ -481 +523 @@
              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
@@ -513 +572 @@
              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
+         
 #ifdef ISO
              IF ((iso_HTO.gt.0).and.(ok_prod_nucl_tritium)) THEN
@@ -572 +640 @@
        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))