Changeset 14072 for NEMO/trunk/src/OCE/DIA/diaptr.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/DIA/diaptr.F90 (modified) (16 diffs)

NEMO/trunk/src/OCE/DIA/diaptr.F90

@@ -66 +66 @@
    !!----------------------------------------------------------------------
    !! NEMO/OCE 4.0 , NEMO Consortium (2018)
-   !! $Id$ 
+   !! $Id$
    !! Software governed by the CeCILL license (see ./LICENSE)
    !!----------------------------------------------------------------------
@@ -75 +75 @@
       !!                  ***  ROUTINE dia_ptr  ***
       !!----------------------------------------------------------------------
-      INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index     
+      INTEGER                         , INTENT(in)           ::   kt     ! ocean time-step index
       INTEGER                         , INTENT(in)           ::   Kmm    ! time level index
       REAL(wp), DIMENSION(A2D(nn_hls),jpk)    , INTENT(in), OPTIONAL ::   pvtr   ! j-effective transport
@@ -177 +177 @@
 
          IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN
-            ! Calculate barotropic heat and salt transport here 
+            ! Calculate barotropic heat and salt transport here
             ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) )
             !
@@ -245 +245 @@
          !
          !                                ! Advective and diffusive heat and salt transport
-         IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN  
-            ! 
+         IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN
+            !
             DO jn = 1, nbasin
                z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
@@ -263 +263 @@
          ENDIF
          !
-         IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN  
-            ! 
+         IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN
+            !
             DO jn = 1, nbasin
                z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
@@ -281 +281 @@
          ENDIF
          !
-         IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN  
-            ! 
+         IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN
+            !
             DO jn = 1, nbasin
                z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt  !  (conversion in PW)
@@ -319 +319 @@
             IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )         ! Use full domain
             CALL iom_get_var(  'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml
-            z2d(:,:) = ptr_ci_2d( z2d(:,:) )  
+            z2d(:,:) = ptr_ci_2d( z2d(:,:) )
             CALL iom_put( 'uocetr_vsum_cumul', z2d )
             IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile )   ! Revert to tile domain
@@ -455 +455 @@
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE dia_ptr_init  ***
-      !!                   
+      !!
       !! ** Purpose :   Initialization
       !!----------------------------------------------------------------------
@@ -472 +472 @@
          &       iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR.  &
          &       iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' )
-      
+
       IF(lwp) THEN                     ! Control print
          WRITE(numout,*)
@@ -480 +480 @@
       ENDIF
 
-      IF( l_diaptr ) THEN  
+      IF( l_diaptr ) THEN
          !
          IF( dia_ptr_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' )
@@ -489 +489 @@
          IF( lk_mpp )   CALL mpp_ini_znl( numout )     ! Define MPI communicator for zonal sum
 
-         btmsk(:,:,1) = tmask_i(:,:)                 
+         btmsk(:,:,1) = tmask_i(:,:)
          IF( nbasin == 5 ) THEN   ! nbasin has been initialized in iom_init to define the axis "basin"
             CALL iom_open( 'subbasins', inum )
@@ -504 +504 @@
          WHERE( gphit(:,:)*tmask_i(:,:) < -34._wp)
            zmsk(:,:) = 0._wp      ! mask out Southern Ocean
-         ELSE WHERE                  
+         ELSE WHERE
            zmsk(:,:) = ssmask(:,:)
          END WHERE
-         btmsk34(:,:,1) = btmsk(:,:,1)                 
+         btmsk34(:,:,1) = btmsk(:,:,1)
          DO jn = 2, nbasin
             btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:)                  ! interior domain only
@@ -514 +514 @@
          ! Initialise arrays to zero because diatpr is called before they are first calculated
          ! Note that this means diagnostics will not be exactly correct when model run is restarted.
-         hstr_adv(:,:,:) = 0._wp           
-         hstr_ldf(:,:,:) = 0._wp           
-         hstr_eiv(:,:,:) = 0._wp           
-         hstr_ove(:,:,:) = 0._wp           
+         hstr_adv(:,:,:) = 0._wp
+         hstr_ldf(:,:,:) = 0._wp
+         hstr_eiv(:,:,:) = 0._wp
+         hstr_ove(:,:,:) = 0._wp
          hstr_btr(:,:,:) = 0._wp           !
          hstr_vtr(:,:,:) = 0._wp           !
@@ -525 +525 @@
          ll_init = .FALSE.
          !
-      ENDIF 
-      ! 
+      ENDIF
+      !
    END SUBROUTINE dia_ptr_init
 
 
-   SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx ) 
+   SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx )
       !!----------------------------------------------------------------------
       !!                    ***  ROUTINE dia_ptr_hst ***
@@ -727 +727 @@
       !
       INTEGER                  ::   ji,jj,jc       ! dummy loop arguments
-      INTEGER                  ::   ijpj        ! ??? 
+      INTEGER                  ::   ijpj        ! ???
       REAL(wp), DIMENSION(jpi,jpj) :: p_fval ! function value
       !!--------------------------------------------------------------------
-      ! 
+      !
       ijpj = jpj  ! ???
       p_fval(:,:) = 0._wp
@@ -738 +738 @@
          END_2D
       END DO
-      ! 
+      !
    END FUNCTION ptr_ci_2d