Changeset 14053 for NEMO/trunk/src/OCE/ISF

Timestamp:

2020-12-03T14:48:38+01:00 (3 years ago)

Author:

techene

Message:

#2385 added to the trunk

Location:

NEMO/trunk/src/OCE/ISF

Files:

• isfcpl.F90 (modified) (10 diffs)
• isfdynatf.F90 (modified) (1 diff)
• isfrst.F90 (modified) (4 diffs)

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

@@ -10 +10 @@
 
    !!----------------------------------------------------------------------
-   !!   isfrst : read/write iceshelf variables in/from restart
+   !!   isfrst        : read/write iceshelf variables in/from restart
    !!----------------------------------------------------------------------
-   USE isf_oce                          ! ice shelf variable
+   USE oce            ! ocean dynamics and tracers
+#if defined key_qco
+   USE domqco  , ONLY : dom_qco_zgr      ! vertical scale factor interpolation
+#else
+   USE domvvl  , ONLY : dom_vvl_zgr      ! vertical scale factor interpolation
+#endif
+   USE domutl  , ONLY : dom_ngb          ! find the closest grid point from a given lon/lat position
+   USE isf_oce        ! ice shelf variable
    USE isfutils, ONLY : debug
-   USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine
-#if ! defined key_qco
-   USE domvvl  , ONLY: dom_vvl_zgr      ! vertical scale factor interpolation
-#else
-   USE domqco   , ONLY: dom_qco_zgr      ! vertical scale factor interpolation
-#endif
-   USE domutl  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position
    !
-   USE oce            ! ocean dynamics and tracers
    USE in_out_manager ! I/O manager
    USE iom            ! I/O library
+   USE lib_mpp , ONLY : mpp_sum, mpp_max ! mpp routine
    !
    IMPLICIT NONE
@@ -34 +34 @@
 
    TYPE isfcons
-      INTEGER :: ii     ! i global
-      INTEGER :: jj     ! j global
-      INTEGER :: kk     ! k level
-      REAL(wp):: dvol   ! volume increment
-      REAL(wp):: dsal   ! salt increment
-      REAL(wp):: dtem   ! heat increment
-      REAL(wp):: lon    ! lon
-      REAL(wp):: lat    ! lat
-      INTEGER :: ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg))
+      INTEGER ::   ii     ! i global
+      INTEGER ::   jj     ! j global
+      INTEGER ::   kk     ! k level
+      REAL(wp)::   dvol   ! volume increment
+      REAL(wp)::   dsal   ! salt increment
+      REAL(wp)::   dtem   ! heat increment
+      REAL(wp)::   lon    ! lon
+      REAL(wp)::   lat    ! lat
+      INTEGER ::   ngb    ! 0/1 (valid location or not (ie on halo or no neigbourg))
    END TYPE
    !
@@ -121 +121 @@
 #endif 
    END SUBROUTINE isfcpl_init
-   ! 
-   SUBROUTINE isfcpl_rst_write(kt, Kmm)
+
+   
+   SUBROUTINE isfcpl_rst_write( kt, Kmm )
       !!---------------------------------------------------------------------
       !!                   ***  ROUTINE iscpl_rst_write  ***
@@ -133 +134 @@
       !!----------------------------------------------------------------------
       INTEGER :: jk                               ! loop index
-      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! e3t , e3u, e3v !!st patch to use substitution
+      REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw  ! for qco substitution
       !!----------------------------------------------------------------------
       !
@@ -153 +154 @@
    END SUBROUTINE isfcpl_rst_write
 
+   
    SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa)
       !!---------------------------------------------------------------------- 
@@ -184 +186 @@
          zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:)
          DO_2D( 0, 0, 0, 0 )
-            jip1=ji+1; jim1=ji-1;
-            jjp1=jj+1; jjm1=jj-1;
+            jip1=ji+1   ;   jim1=ji-1
+            jjp1=jj+1   ;   jjm1=jj-1
             !
             zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1)
@@ -191 +193 @@
             IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN
                ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj)     &
-               &           + zssh(jim1,jj)*zssmask0(jim1,jj)     &
-               &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     &
-               &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk
+                  &           + zssh(jim1,jj)*zssmask0(jim1,jj)     &
+                  &           + zssh(ji,jjp1)*zssmask0(ji,jjp1)     &
+                  &           + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk
                zssmask_b(ji,jj) = 1._wp
             ENDIF
@@ -222 +224 @@
       CALL dom_vvl_zgr(Kbb, Kmm, Kaa)
 #else
-      CALL dom_qco_zgr(Kbb, Kmm, Kaa)
+      CALL dom_qco_zgr(Kbb, Kmm)
 #endif
       !
    END SUBROUTINE isfcpl_ssh
 
+   
    SUBROUTINE isfcpl_tra(Kmm)
       !!---------------------------------------------------------------------- 
@@ -375 +378 @@
       ! 
    END SUBROUTINE isfcpl_tra
+   
 
    SUBROUTINE isfcpl_vol(Kmm)
@@ -466 +470 @@
          risfcpl_ssh(:,:) = risfcpl_ssh(:,:) + risfcpl_vol(:,:,jk) * r1_e1e2t(:,:)
       END DO
-
+      !
    END SUBROUTINE isfcpl_vol
 
+   
    SUBROUTINE isfcpl_cons(Kmm)
       !!---------------------------------------------------------------------- 

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

@@ -15 +15 @@
    USE phycst , ONLY: r1_rho0         ! physical constant
    USE dom_oce                        ! time and space domain
-   USE oce, ONLY : ssh                ! sea-surface height !!st needed for substitution
+   USE oce, ONLY : ssh                ! sea-surface height for qco substitution
 
    USE in_out_manager

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

@@ -28 +28 @@
    !!----------------------------------------------------------------------
 CONTAINS
-   ! 
-   SUBROUTINE isfrst_read(cdisf, ptsc, pfwf, ptsc_b, pfwf_b )
+   
+   SUBROUTINE isfrst_read( cdisf, ptsc, pfwf, ptsc_b, pfwf_b )
       !!---------------------------------------------------------------------
       !!
@@ -51 +51 @@
       !
       ! read restart
-      IF( iom_varid( numror, cfwf_b, ldstop = .FALSE. ) > 0 ) THEN
+      IF( .NOT.l_1st_euler ) THEN
          IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file'
          CALL iom_get( numror, jpdom_auto, cfwf_b, pfwf_b(:,:)         )   ! before ice shelf melt
@@ -62 +62 @@
       !
    END SUBROUTINE isfrst_read
-   ! 
-   SUBROUTINE isfrst_write(kt, cdisf, ptsc, pfwf )
+
+   
+   SUBROUTINE isfrst_write( kt, cdisf, ptsc, pfwf )
       !!---------------------------------------------------------------------
       !!
@@ -94 +95 @@
       !
    END SUBROUTINE isfrst_write
-   !
+   
+   !!======================================================================
 END MODULE isfrst