Changeset 15351

Timestamp:

2021-10-11T15:53:53+02:00 (3 years ago)

Author:

cetlod

Message:

dev_PISCO : minor bugfix

Location:

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES

Files:

• P4Z/p4zbc.F90 (modified) (5 diffs)
• P4Z/p4zint.F90 (modified) (2 diffs)
• P4Z/p4zlim.F90 (modified) (1 diff)
• P4Z/p4zopt.F90 (modified) (1 diff)
• P4Z/p5zmeso.F90 (modified) (8 diffs)
• SED/sedchem.F90 (modified) (1 diff)
• SED/sedsfc.F90 (modified) (1 diff)
• SED/sedsol.F90 (modified) (5 diffs)
• SED/trosk.F90 (modified) (5 diffs)

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/P4Z/p4zbc.F90

@@ -101 +101 @@
          ! Atmospheric input of Iron dissolves in the water column
          IF ( ln_trc_sbc(jpfer) ) THEN
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
                zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
                !
@@ -118 +118 @@
          ! Atmospheric input of PO4 dissolves in the water column
          IF ( ln_trc_sbc(jppo4) ) THEN
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
                zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
                !
@@ -127 +127 @@
          ! Atmospheric input of Si dissolves in the water column
          IF ( ln_trc_sbc(jpsil) ) THEN
-            DO_3D( 1, 1, 1, 1, 2, jpkm1 )
+            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 )
                zdustdep = dust(ji,jj) * zwdust * rfact * EXP( -gdept(ji,jj,jk,Kmm) /( 250. * wdust ) )
                !
@@ -160 +160 @@
          IF( ln_trc_sbc(jpno3) ) THEN
             jl = n_trc_indsbc(jpno3)
-            DO_2D( 1, 1, 1, 1 )
+            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time
                tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) - rno3 * zndep * rfact
@@ -167 +167 @@
          IF( ln_trc_sbc(jpnh4) ) THEN
             jl = n_trc_indsbc(jpnh4)
-            DO_2D( 1, 1, 1, 1 )
+            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
                zndep = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) / e3t(ji,jj,1,Kmm) / rn_sbc_time
                tr(ji,jj,1,jptal,Krhs) = tr(ji,jj,1,jptal,Krhs) + rno3 * zndep * rfact

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/P4Z/p4zint.F90

@@ -75 +75 @@
       ! day length in hours
       strn(:,:) = 0.
-      DO_2D( 1, 1, 1, 1 )
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
          zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
          zargu = MAX( -1., MIN(  1., zargu ) )
@@ -81 +81 @@
       END_2D
       !
-      DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
         ! denitrification factor computed from O2 levels
          ! This factor diagnoses below which level of O2 denitrification

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/P4Z/p4zlim.F90

@@ -220 +220 @@
       ! Assumes that larger biomass implies addition of larger cells
       ! ------------------------------------------------------------
-      DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
          zcoef = tr(ji,jj,jk,jpphy,Kbb) - MIN(xsizephy, tr(ji,jj,jk,jpphy,Kbb) )
          sizena(ji,jj,jk) = 1. + ( xsizern -1.0 ) * zcoef / ( xsizephy + zcoef )

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/P4Z/p4zopt.F90

@@ -372 +372 @@
          pe3(:,:,1) = zqsr(:,:)
          !
-         DO_3D( 1, 1, 1, 1, 2, nksr + 1 )
+         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, nksr + 1)
             pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r )
             pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        )

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/P4Z/p5zmeso.F90

@@ -428 +428 @@
           ! the fluxes driven by mesozooplankton in the euphotic zone.
           ! --------------------------------------------------------------------
-          DO_3D( 1, 1, 1, 1, 1, jpkm1 )        
+          DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
              zmigreltime = (1. - strn(ji,jj))
              IF( gdept(ji,jj,jk,Kmm) <= heup(ji,jj) ) THEN
@@ -461 +461 @@
           ! the migration depth (corresponding indice is set by kmig)
           ! --------------------------------------------------------------------------------
-          DO_2D( 1, 1, 1, 1 )
+          DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
              IF( tmask(ji,jj,1) == 1. ) THEN
                  jkt = kmig(ji,jj)
@@ -491 +491 @@
         !   nutrients, DOC agands, and particulate organic carbon). 
         !   ---------------------------------------------------------------------
-      DO_3D( 1, 1, 1, 1, 1, jpkm1 )        
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1)
          tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarep(ji,jj,jk) 
          tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgraren(ji,jj,jk)
@@ -627 +627 @@
       ! 150m to 500 m depth.
       ! ------------------------------------------------------------------
-      DO_3D( 1, 1, 1, 1, 1, jpk )
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk )
          IF( tmask(ji,jj,jk) == 1.) THEN
             IF( gdept(ji,jj,jk,Kmm) >= 150. .AND. gdept(ji,jj,jk,kmm) <= 500.) THEN
@@ -640 +640 @@
       ! domain
       ! ------------------------------------------------------------------------------------
-      DO_2D( 1, 1, 1, 1 )
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
          z1dep = 1. / ( zdepmoy(ji,jj) + rtrn )
          oxymoy(ji,jj)  = tr(ji,jj,1,jpoxy,Kbb) * 1E6 - oxymoy(ji,jj)  * z1dep
@@ -649 +649 @@
       ! Bianchi et al. (2013)
       ! -------------------------------------------------------------------
-      DO_2D( 1, 1, 1, 1 )
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
          IF( tmask(ji,jj,1) == 1. ) THEN
             ztotchl = ( tr(ji,jj,1,jppch,Kbb) + tr(ji,jj,1,jpnch,Kbb) + tr(ji,jj,1,jpdch,Kbb) ) * 1E6
@@ -658 +658 @@
             ! Computation of the corresponding jk indice 
       ! ------------------------------------------
-      DO_3D( 1, 1, 1, 1, 1, jpkm1 )
+      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 )
          IF( depmig(ji,jj) >= gdepw(ji,jj,jk,Kmm) .AND. depmig(ji,jj) < gdepw(ji,jj,jk+1,Kmm) ) THEN
              kmig(ji,jj) = jk
@@ -670 +670 @@
       ! that it falls above the OMZ
       ! -----------------------------------------------------------------------
-      DO_2D( 1, 1, 1, 1 )
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
          IF( tr(ji,jj,kmig(ji,jj),jpoxy,Kbb) < 5E-6 ) THEN
             DO jk = kmig(ji,jj),1,-1

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/SED/sedchem.F90

@@ -139 +139 @@
          CALL sed_chem_cst
       ELSE
-         DO_2D( 1, 1, 1, 1 )
+         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
             ikt = mbkt(ji,jj) 
             IF ( tmask(ji,jj,ikt) == 1 ) THEN

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/SED/sedsfc.F90

@@ -49 +49 @@
       CALL unpack_arr ( jpoce, trc_data(1:jpi,1:jpj,9), iarroce(1:jpoce), pwcp(1:jpoce,1,jwlgw) )
 
-
-      DO_2D( 1, 1, 1, 1 )
+      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )
          ikt = mbkt(ji,jj)
          IF ( tmask(ji,jj,ikt) == 1 ) THEN

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/SED/sedsol.F90

@@ -17 +17 @@
    USE sedmat
    USE sedorg
-   USE tros
+# if ! defined key_agrif
+   USE trosk
+#endif
    USE lib_mpp         ! distribued memory computing library
    USE lib_fortran
@@ -58 +60 @@
       INTEGER  :: ji, jk, js, jw, jn, neq   ! dummy looop indices
       REAL(wp), DIMENSION( jpoce, jpvode * jpksed ) :: ZXIN, FVAL
+# if ! defined key_agrif      
       REAL(wp), DIMENSION(jpoce,jpksed) :: preac
       INTEGER :: JINDEX, ITOL, IJAC, MLJAC, IMAX
@@ -69 +72 @@
       INTEGER, DIMENSION(jpoce,3)   :: ISTAT
       REAL(wp), DIMENSION(jpoce,2)  :: RSTAT
+#endif      
       !!
       !!----------------------------------------------------------------------
@@ -161 +165 @@
       CALL sed_co3( kt )
 
+# if ! defined key_agrif
       ! The following part deals with the stiff ODEs
       ! This is the expensive part of the code and should be carefully
@@ -227 +232 @@
 
       DEALLOCATE( WORK )
+#endif
 
       preac(:,:) = 0.

NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/TOP/PISCES/SED/trosk.F90

@@ -1 @@
-MODULE TROS
+MODULE trosk
+# if ! defined key_agrif
 !****************************************************************
 !* NUMERICAL SOLUTION OF A STIFF SYSTEM OF FIRST 0RDER ORDINARY *
@@ -19 +20 @@
   PRIVATE 
 
-  PUBLIC ROSK
+  PUBLIC rosk
 
   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: NFCN, NJAC, NSTEP, NACCPT, NREJCT, NDEC, NSOL
@@ -38 +39 @@
 
 !**********************************************************************
-SUBROUTINE ROSK(ROSM,N,X,Y,XEND,H, RTOL,ATOL,ITOL,                  &
+SUBROUTINE rosk(ROSM,N,X,Y,XEND,H, RTOL,ATOL,ITOL,                  &
            &    JAC, MLJAC, MUJAC, WORK,LWORK,IDID,ISTAT,RSTAT)
 ! ---------------------------------------------------------------------
@@ -309 +310 @@
       RETURN
 
-      END SUBROUTINE ROSK
+      END SUBROUTINE rosk
 
       SUBROUTINE RO3COR(N,X,Y,XEND,HMAX,H,RTOL,ATOL,ITOL,JAC,         &
@@ -1060 +1061 @@
 !----------------------- END OF SUBROUTINE SOLB ------------------------
       END SUBROUTINE SOLB
-
-END MODULE TROS
+#endif
+END MODULE trosk