Changeset 3465 for LMDZ6/trunk/libf/phylmd/cpl_mod.F90

Timestamp:

Mar 14, 2019, 10:34:31 AM (6 years ago)

Author:

Laurent Fairhead

Message:

Further modifications for DYNAMICO/LMDZ convergence. These are based
on Yann's LMDZ6_V2 sources. Compiles on irene and converges with revision 3459
in a bucket configuration
YM/LF

File:

• LMDZ6/trunk/libf/phylmd/cpl_mod.F90 (modified) (9 diffs)

LMDZ6/trunk/libf/phylmd/cpl_mod.F90

@@ -97 +97 @@
   !$OMP THREADPRIVATE(cpl_atm_co22D)
 
+!!!!!!!!!! variable for calving
+  INTEGER, PARAMETER :: nb_zone_calving = 3
+  REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving 
+  !$OMP THREADPRIVATE(area_calving)
+  REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D 
+  !$OMP THREADPRIVATE(cell_area2D)
+  INTEGER, SAVE :: ind_calving(nb_zone_calving) 
+  !$OMP THREADPRIVATE(ind_calving)
+
+  LOGICAL,SAVE :: cpl_old_calving
+  !$OMP THREADPRIVATE(cpl_old_calving)
+  
 CONTAINS
 !
@@ -105 +117 @@
     USE surface_data
     USE indice_sol_mod
-    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo
+    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo, klon_glo, grid_type, unstructured, regular_lonlat
     USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy
     USE print_control_mod, ONLY: lunout
+    USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area
+    USE ioipsl_getin_p_mod, ONLY: getin_p
 
 ! Input arguments
@@ -127 +141 @@
     CHARACTER(len = 80)               :: abort_message
     CHARACTER(len=80)                 :: clintocplnam, clfromcplnam
+    REAL, DIMENSION(klon_mpi)         :: rlon_mpi, rlat_mpi, cell_area_mpi
+    INTEGER, DIMENSION(klon_mpi)           :: ind_cell_glo_mpi
+    REAL, DIMENSION(nbp_lon,jj_nb)         :: lon2D, lat2D
+    INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving)
+    REAL :: pos
+
+!***************************************
+! Use old calving or not (default no)
+    cpl_old_calving=.FALSE.
+    CALL getin_p("cpl_old_calving",cpl_old_calving)
+
 
 !*************************************************************************************
@@ -208 +233 @@
     ENDIF
 
+! calving initialization
+    ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error)
+    sum_error = sum_error + error
+    ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error)    
+    sum_error = sum_error + error
+
+
+    CALL gather_omp(longitude_deg,rlon_mpi)
+    CALL gather_omp(latitude_deg,rlat_mpi)
+    CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
+    CALL gather_omp(cell_area,cell_area_mpi)
+      
+    IF (is_omp_master) THEN
+      CALL Grid1DTo2D_mpi(rlon_mpi,lon2D)
+      CALL Grid1DTo2D_mpi(rlat_mpi,lat2D)
+      CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D)
+      mask_calving(:,:,:) = 0 
+      WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1
+      WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1
+      WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1
+    
+    
+      DO i=1,nb_zone_calving
+        area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:)
+        pos=1
+        IF (i>1) pos = 1 + ((nbp_lon*nbp_lat-1)*(i-1))/(nb_zone_calving-1)
+      
+        ind_calving(i)=0
+        IF (grid_type==unstructured) THEN
+
+          DO ig=1,klon_mpi
+            IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig
+          ENDDO
+
+        ELSE IF (grid_type==regular_lonlat) THEN
+          IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN
+            ind_calving(i)=pos-(jj_begin-1)*nbp_lon
+          ENDIF
+        ENDIF
+     
+      ENDDO
+    ENDIF
+    
+           
     IF (sum_error /= 0) THEN
        abort_message='Pb allocation variables couplees'
@@ -1086 +1155 @@
 ! Local variables
 !*************************************************************************************
-    INTEGER                                              :: error, sum_error, j
+    INTEGER                                              :: error, sum_error, i,j,k
     INTEGER                                              :: itau_w
     INTEGER                                              :: time_sec
@@ -1103 +1172 @@
 ! Table with all fields to send to coupler
     REAL, DIMENSION(nbp_lon, jj_nb, maxsend)                 :: tab_flds
-    REAL, DIMENSION(klon_mpi)                            :: rlon_mpi, rlat_mpi
-
+    REAL, DIMENSION(klon_mpi)                                :: rlon_mpi, rlat_mpi
+    REAL  :: calving(nb_zone_calving)
+    REAL  :: calving_glo(nb_zone_calving)
+    
 #ifdef CPP_MPI
     INCLUDE 'mpif.h'
@@ -1131 +1202 @@
     
     IF (version_ocean=='nemo') THEN
-       tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)
+       tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:))
        IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
     ELSE IF (version_ocean=='opa8') THEN
@@ -1158 +1229 @@
 !*************************************************************************************      
     IF (is_omp_root) THEN
+
+      IF (cpl_old_calving) THEN   ! use old calving
 
       DO j = 1, jj_nb
@@ -1190 +1263 @@
          ENDIF
       ENDIF
+      tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
+
+      ENDIF
+
+      DO k=1,nb_zone_calving
+        calving(k)=0
+        DO j = 1, jj_nb
+          calving(k)= calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic))
+        ENDDO
+      ENDDO
       
-      tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
+      CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
+      
+      tab_flds(:,:,ids_calvin) = 0
+      DO k=1,nb_zone_calving
+        IF (ind_calving(k)>0 ) THEN
+          j=(ind_calving(k)-1)/nbp_lon + 1
+          i=MOD(ind_calving(k)-1,nbp_lon)+1
+          tab_flds(i,j,ids_calvin) = calving_glo(k)
+        ENDIF
+      ENDDO
 
 !*************************************************************************************