Changeset 14072 for NEMO/trunk/src/OCE/ISF/isfcpl.F90

Timestamp:

2020-12-04T08:48:38+01:00 (3 years ago)

Author:

laurent

Message:

Merging branch "2020/dev_r13648_ASINTER-04_laurent_bulk_ice", ticket #2369

File:

• NEMO/trunk/src/OCE/ISF/isfcpl.F90 (modified) (23 diffs)

NEMO/trunk/src/OCE/ISF/isfcpl.F90

@@ -30 +30 @@
    PRIVATE
 
-   PUBLIC isfcpl_rst_write, isfcpl_init                    ! iceshelf restart read and write 
-   PUBLIC isfcpl_ssh, isfcpl_tra, isfcpl_vol, isfcpl_cons  ! iceshelf correction for ssh, tra, dyn and conservation 
+   PUBLIC isfcpl_rst_write, isfcpl_init                    ! iceshelf restart read and write
+   PUBLIC isfcpl_ssh, isfcpl_tra, isfcpl_vol, isfcpl_cons  ! iceshelf correction for ssh, tra, dyn and conservation
 
    TYPE isfcons
@@ -57 +57 @@
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE iscpl_init  ***
-      !! 
-      !! ** Purpose : correct ocean state for new wet cell and horizontal divergence 
+      !!
+      !! ** Purpose : correct ocean state for new wet cell and horizontal divergence
       !!              correction for the dynamical adjustement
       !!
@@ -74 +74 @@
       ! start on an euler time step
       l_1st_euler = .TRUE.
-      ! 
+      !
       ! allocation and initialisation to 0
       CALL isf_alloc_cpl()
@@ -88 +88 @@
       IF(lwp) WRITE(numout,*) ' isfcpl_init:', id
       IF (id == 0) THEN
-         IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg ' 
+         IF(lwp) WRITE(numout,*) ' isfcpl_init: restart variables for ice sheet coupling are missing, skip coupling for this leg '
          IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
          IF(lwp) WRITE(numout,*) ''
@@ -119 +119 @@
 #if ! defined key_qco
       e3t(:,:,:,Kbb)   = e3t(:,:,:,Kmm)
-#endif 
+#endif
    END SUBROUTINE isfcpl_init
 
-   
+
    SUBROUTINE isfcpl_rst_write( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE iscpl_rst_write  ***
-      !! 
+      !!
       !! ** Purpose : write icesheet coupling variables in restart
       !!
@@ -143 +143 @@
          !
          zgdepw(:,:,jk) = gdepw(:,:,jk,Kmm)
-      END DO 
+      END DO
       !
       CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask  )
@@ -154 +154 @@
    END SUBROUTINE isfcpl_rst_write
 
-   
+
    SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa)
-      !!---------------------------------------------------------------------- 
+      !!----------------------------------------------------------------------
       !!                   ***  ROUTINE iscpl_ssh  ***
-      !! 
+      !!
       !! ** Purpose :   basic guess of ssh in new wet cell
-      !! 
+      !!
       !! ** Method  :   basic extrapolation from neigbourg cells
       !!
@@ -176 +176 @@
       CALL iom_get( numror, jpdom_auto, 'ssmask'  , zssmask_b   ) ! need to extrapolate T/S
 
-      ! compute new ssh if we open a full water column 
+      ! compute new ssh if we open a full water column
       ! rude average of the closest neigbourgs (e1e2t not taking into account)
       !
@@ -229 +229 @@
    END SUBROUTINE isfcpl_ssh
 
-   
+
    SUBROUTINE isfcpl_tra(Kmm)
-      !!---------------------------------------------------------------------- 
+      !!----------------------------------------------------------------------
       !!                   ***  ROUTINE iscpl_tra  ***
-      !! 
-      !! ** Purpose :   compute new tn, sn in case of evolving geometry of ice shelves 
-      !! 
+      !!
+      !! ** Purpose :   compute new tn, sn in case of evolving geometry of ice shelves
+      !!
       !! ** Method  :   tn, sn : basic extrapolation from neigbourg cells
       !!
@@ -250 +250 @@
       REAL(wp):: zdz, zdzm1, zdzp1
       !!
-      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask 
+      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask
       REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn
       REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0
       !!----------------------------------------------------------------------
-      ! 
+      !
       CALL iom_get( numror, jpdom_auto, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S
       !CALL iom_get( numror, jpdom_auto, 'wmask'  , zwmask_b  ) ! need to extrapolate T/S
       !CALL iom_get( numror, jpdom_auto, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl)
       !
-      ! 
+      !
       ! compute new T/S (interpolation) if vvl only for common wet cell in before and after wmask
       !PM: Is this IF needed since change to VVL by default
@@ -376 +376 @@
             &                         in your domain cfg computation'         )
       END_3D
-      ! 
+      !
    END SUBROUTINE isfcpl_tra
-   
+
 
    SUBROUTINE isfcpl_vol(Kmm)
-      !!---------------------------------------------------------------------- 
+      !!----------------------------------------------------------------------
       !!                   ***  ROUTINE iscpl_vol  ***
-      !! 
-      !! ** Purpose : compute the correction of the local divergence to apply  
+      !!
+      !! ** Purpose : compute the correction of the local divergence to apply
       !!              during the first time step after the coupling.
       !!
@@ -390 +390 @@
       !!              - compute vertical input
       !!              - compute correction
-      !!                
+      !!
       !!----------------------------------------------------------------------
       !!
       INTEGER, INTENT(in) :: Kmm    ! ocean time level index
       !!----------------------------------------------------------------------
-      INTEGER :: ji, jj, jk 
+      INTEGER :: ji, jj, jk
       INTEGER :: ikb, ikt
       !!
@@ -421 +421 @@
          !
          ! 1.2: get volume flux after coupling (>0 out)
-         ! properly mask velocity 
+         ! properly mask velocity
          ! (velocity are still mask with old mask at this stage)
          uu(:,:,jk,Kmm) = uu(:,:,jk,Kmm) * umask(:,:,jk)
@@ -459 +459 @@
       !
       ! 3.2: get 3d tr(:,:,:,:,Krhs) increment to apply at the first time step
-      ! temperature and salt content flux computed using local ts(:,:,:,:,Kmm) 
+      ! temperature and salt content flux computed using local ts(:,:,:,:,Kmm)
       ! (very simple advection scheme)
       ! (>0 out)
@@ -473 +473 @@
    END SUBROUTINE isfcpl_vol
 
-   
+
    SUBROUTINE isfcpl_cons(Kmm)
-      !!---------------------------------------------------------------------- 
+      !!----------------------------------------------------------------------
       !!                   ***  ROUTINE iscpl_cons  ***
-      !! 
+      !!
       !! ** Purpose :   compute the corrective increment in volume/salt/heat to put back the vol/heat/salt
       !!                removed or added during the coupling processes (wet or dry new cell)
-      !! 
+      !!
       !! ** Method  :   - compare volume/heat/salt before and after
       !!                - look for the closest wet cells (share amoung neigbourgs if there are)
       !!                - build the correction increment to applied at each time step
-      !!                
+      !!
       !!----------------------------------------------------------------------
       !
@@ -496 +496 @@
       INTEGER  ::   iig  , ijg, ik                    ! dummy indices
       INTEGER  ::   jisf                              ! start, end and current position in the increment array
-      INTEGER  ::   ingb, ifind                       ! 0/1 target found or need to be found 
-      INTEGER  ::   nisfl_area                        ! global number of cell concerned by the wet->dry case 
+      INTEGER  ::   ingb, ifind                       ! 0/1 target found or need to be found
+      INTEGER  ::   nisfl_area                        ! global number of cell concerned by the wet->dry case
       INTEGER, DIMENSION(jpnij) :: nisfl              ! local  number of cell concerned by the wet->dry case
       !
       REAL(wp) ::   z1_sum, z1_rdtiscpl
       REAL(wp) ::   zdtem, zdsal, zdvol, zratio       ! tem, sal, vol increment
-      REAL(wp) ::   zlon , zlat                       ! target location  
+      REAL(wp) ::   zlon , zlat                       ! target location
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b    ! mask before
       REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b      ! scale factor before
@@ -522 +522 @@
       nstp_iscpl  = nitend - nit000 + 1
       rdt_iscpl   = nstp_iscpl * rn_Dt
-      z1_rdtiscpl = 1._wp / rdt_iscpl 
+      z1_rdtiscpl = 1._wp / rdt_iscpl
 
       IF (lwp) WRITE(numout,*) '            nb of stp for cons  = ', nstp_iscpl
@@ -552 +552 @@
                zdsal = ts(ji,jj,jk,jp_sal,Kmm) *  e3t(ji,jj,jk,Kmm) *  tmask  (ji,jj,jk)   &
                      - zs_b(ji,jj,jk)       * ze3t_b(ji,jj,jk) * ztmask_b(ji,jj,jk)
-            
+
                ! volume, heat and salt differences in each cell (>0 means correction is an outward flux)
                ! in addition to the geometry change unconservation, need to add the divergence correction as it is flux across the boundary
@@ -575 +575 @@
             DO ji = Nis0,Nie0
                jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ;
-               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN 
+               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN
                   nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp)
                ENDIF
@@ -582 +582 @@
       ENDDO
       !
-      ! global 
+      ! global
       CALL mpp_sum('isfcpl',nisfl  )
       !
@@ -636 +636 @@
       ! share data among all processes because for some point we need to find the closest wet point (could be on other process)
       DO jproc=1,jpnij
-         ! 
+         !
          ! share total number of isf point treated for proc jproc
          IF (jproc==narea) THEN
@@ -660 +660 @@
                ingb = zisfpts(jisf)%ngb
             ELSE
-               iig  =0   ; ijg  =0   ; ik   =0  
+               iig  =0   ; ijg  =0   ; ik   =0
                zdvol=-HUGE(1.0) ; zdsal=-HUGE(1.0) ; zdtem=-HUGE(1.0)
-               zlat =-HUGE(1.0) ; zlon =-HUGE(1.0)   
+               zlat =-HUGE(1.0) ; zlon =-HUGE(1.0)
                ingb = 0
             END IF
@@ -711 +711 @@
       INTEGER,                     INTENT(inout) :: kpts
       !!----------------------------------------------------------------------
-      INTEGER,      INTENT(in   )           :: ki, kj, kk                  !    target location (kfind=0) 
+      INTEGER,      INTENT(in   )           :: ki, kj, kk                  !    target location (kfind=0)
       !                                                                    ! or source location (kfind=1)
       INTEGER,      INTENT(in   ), OPTIONAL :: kfind                       ! 0  target cell already found
       !                                                                    ! 1  target to be determined
-      REAL(wp),     INTENT(in   )           :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment 
+      REAL(wp),     INTENT(in   )           :: pdvol, pdsal, pdtem, pratio ! vol/sal/tem increment
       !                                                                    ! and ratio in case increment span over multiple cells.
       !!----------------------------------------------------------------------
       INTEGER :: ifind
       !!----------------------------------------------------------------------
-      ! 
+      !
       ! increment position
       kpts = kpts + 1