Changeset 5835

Timestamp:

2015-10-26T15:41:05+01:00 (8 years ago)

Author:

mathiot

Message:

ice sheet coupling branche: cosmetic changes

Location:

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC

Files:

• DOM/iscplhsb.F90 (modified) (3 diffs)
• DOM/iscplini.F90 (modified) (1 diff)
• DOM/iscplrst.F90 (modified) (5 diffs)
• LBC/lib_mpp.F90 (modified) (2 diffs)
• lib_fortran.F90 (modified) (3 diffs)

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

@@ -82 +82 @@
       pvol_flx(:,:,:  ) = 0.0_wp
       pts_flx (:,:,:,:) = 0.0_wp
+      r1_tiscpl = 1._wp / (prdt_iscpl * rn_rdt) 
 
       ! mask tsn and tsb 
@@ -87 +88 @@
       tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:);
 
-      ! diagnose non conservation of heat, salt and volume 
-      r1_tiscpl = 1._wp / (prdt_iscpl * rn_rdt) 
-
+      !==============================================================================
+      ! diagnose the heat, salt and volume input and compute the correction variable
+      !==============================================================================
+
+      ! 
       zssh0(:,:)        = sshn(:,:) * ssmask(:,:) - sshb(:,:) * psmask_b(:,:)
       IF ( lk_vvl ) zssh0 = 0.0_wp ! already include in the levels by definition
-
+      
       DO jk = 1,jpk-1
          DO ji = 2,jpi-1
@@ -119 +122 @@
                   pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem(ji,jj) * r1_tiscpl
 
+                  ! case where we close a cell: check if the neighbour cells are wet 
                   IF ( tmask(ji,jj,jk) == 0._wp .AND. ptmask_b(ji,jj,jk) == 1._wp ) THEN
-                     ! case where we close a cell: check if the neighbour cells are wet 
 
                      jip1=ji+1 ; jim1=ji-1 ; jjp1=jj+1 ; jjm1=jj-1 ;

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90

@@ -8 +8 @@
 
    !!----------------------------------------------------------------------
-   !!   iscpl_rst          : restart correction    in case of coupling with ice sheet
-   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
+   !!   iscpl_init     : initialisation routine (namelist)
+   !!   iscpl_alloc    : allocation of correction variables
    !!----------------------------------------------------------------------
    USE dom_oce         ! ocean space and time domain

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

@@ -8 +8 @@
 
    !!----------------------------------------------------------------------
+   !!   iscpl_stp          : step management
    !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet
    !!----------------------------------------------------------------------
@@ -68 +69 @@
       CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b   ) ! need to correct barotropic velocity
       CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b   ) ! need to correct barotropic velocity
-      CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', ze3t_b(:,:,:) ) ! need to compute temperature correction
-      CALL iom_get( numror, jpdom_autoglo, 'fse3u_n', ze3u_b(:,:,:) ) ! need to compute volume      correction  ????
-      CALL iom_get( numror, jpdom_autoglo, 'fse3v_n', ze3v_b(:,:,:) ) ! need to compute volume      correction  ????
-      CALL iom_get( numror, jpdom_autoglo, 'fsdepw_n', zdepw_b(:,:,:) ) ! need to compute volume      correction  ????
+      CALL iom_get( numror, jpdom_autoglo, 'fse3t_n' , ze3t_b(:,:,:) )  ! need to compute temperature correction
+      CALL iom_get( numror, jpdom_autoglo, 'fse3u_n' , ze3u_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'fse3v_n' , ze3v_b(:,:,:) )  ! need to correct barotropic velocity
+      CALL iom_get( numror, jpdom_autoglo, 'fsdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl)
 
       !! read namelist
@@ -105 +106 @@
       !! next step is an euler time step
       neuler = 0
+
       !! set _b and _n variables equal
       tsb (:,:,:,:) = tsn (:,:,:,:)
@@ -110 +112 @@
       vb  (:,:,:  ) = vn  (:,:,:  )
       sshb(:,:    ) = sshn(:,:)
+
       !! set _b and _n vertical scale factor equal
       fse3t_b (:,:,:) = fse3t_n (:,:,:)
@@ -158 +161 @@
       !! allocate variables
       CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   )
-      CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d         ) 
+      CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        ) 
       CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       ) 
       CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       ) 

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

@@ -1399 +1399 @@
       !!                  ***  routine mpp_lnk_sum_3d  ***
       !!
-      !! ** Purpose :   Message passing manadgement (sum in the overlap region)
+      !! ** Purpose :   Message passing manadgement (sum the overlap region)
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing mask
@@ -1572 +1572 @@
       !!                  ***  routine mpp_lnk_sum_2d  ***
       !!
-      !! ** Purpose :   Message passing manadgement for 2d array (sum in the overlap region)
+      !! ** Purpose :   Message passing manadgement for 2d array (sum the overlap region)
       !!
       !! ** Method  :   Use mppsend and mpprecv function for passing mask

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

@@ -24 +24 @@
    PRIVATE
 
-   PUBLIC   glob_sum   ! used in many places
-   PUBLIC   glob_sum_full   ! used in many places
-   PUBLIC   DDPDD      ! also used in closea module
+   PUBLIC   glob_sum      ! used in many places (masked with tmask_i)
+   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos)
+   PUBLIC   DDPDD         ! also used in closea module
    PUBLIC   glob_min, glob_max
 #if defined key_nosignedzero
@@ -360 +360 @@
    FUNCTION glob_sum_full_2d( ptab )
       !!----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_2d ***
+      !!                  ***  FUNCTION  glob_sum_full_2d ***
       !!
       !! ** Purpose : perform a sum in calling DDPDD routine
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab
-      REAL(wp)                             ::   glob_sum_full_2d   ! global masked sum
+      REAL(wp)                             ::   glob_sum_full_2d   ! global sum (nomask)
       !!
       COMPLEX(wp)::   ctmp
@@ -387 +387 @@
    FUNCTION glob_sum_full_3d( ptab )
       !!----------------------------------------------------------------------
-      !!                  ***  FUNCTION  glob_sum_3d ***
+      !!                  ***  FUNCTION  glob_sum_full_3d ***
       !!
       !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine
       !!----------------------------------------------------------------------
       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab
-      REAL(wp)                               ::   glob_sum_full_3d   ! global masked sum
+      REAL(wp)                               ::   glob_sum_full_3d   ! global sum (nomask)
       !!
       COMPLEX(wp)::   ctmp