Changeset 775 for branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zint.F90

Timestamp:

2007-12-19T14:45:15+01:00 (16 years ago)

Author:

gm

Message:

dev_001_GM - PISCES in F90 : encapsulation of all p4z...F files in module F90 + doctor norme for local variables - compilation OK

File:

• branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zint.F90 (moved) (moved from branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zint.F) (2 diffs)

branches/dev_001_GM/NEMO/TOP_SRC/PISCES_SMS/p4zint.F90

@@ +1 @@
+MODULE p4zint
+   !!======================================================================
+   !!                         ***  MODULE p4zint  ***
+   !! TOP :   PISCES interpolation and computation of various accessory fields
+   !!======================================================================
+   !! History :   1.0  !  2004-03 (O. Aumont) Original code
+   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
+   !!----------------------------------------------------------------------
+#if defined key_pisces
+   !!----------------------------------------------------------------------
+   !!   'key_pisces'                                       PISCES bio-model
+   !!----------------------------------------------------------------------
+   !!   p4z_int        :  interpolation and computation of various accessory fields
+   !!----------------------------------------------------------------------
+   USE oce_trc         !
+   USE trp_trc
+   USE sms
 
-CCC $Header$ 
-CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
-C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
-C ---------------------------------------------------------------------------
-CDIR$ LIST
-      SUBROUTINE p4zint(kt)
-#if defined key_top && defined key_pisces
-CCC
-CCC
-CCC       ROUTINE p4zint : PISCES MODEL
-CCC       *****************************
-CCC
-CC
-CC   PURPOSE :
-CC   ---------
-CC           *P4ZINT* INTERPOLATION AND COMPUTATION OF 
-CC                    VARIOUS ACCESSORY FIELDS
-CC   INPUT :
-CC   -----
-CC      argument
-CC              kt              : time step
-CC
-CC   EXTERNAL :
-CC   ----------
-CC          NONE
-CC
-CC   MODIFICATIONS:
-CC   --------------
-CC      original      : 2004    O. Aumont
-CC ----------------------------------------------------------------
-CC parameters and commons
-CC ======================
-CDIR$ NOLIST
-      USE oce_trc
-      USE trp_trc
-      USE sms
-      IMPLICIT NONE
-CDIR$ LIST
-CC-----------------------------------------------------------------
-CC------
-CC local declarations
-CC ==================
-C
-      INTEGER kt
-      INTEGER ji, jj
-      INTEGER iman
-      INTEGER nspyr,nvit1t,nvit2t
-      REAL zpdtan, zman, zpdtmo, zdemi
-      REAL zt, zdum
-C
-C
+   IMPLICIT NONE
+   PRIVATE
+
+   PUBLIC   p4z_int    ! called in p4zprg.F90
+
+   !!----------------------------------------------------------------------
+   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 
+   !! $Header:$ 
+   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
+   !!----------------------------------------------------------------------
+
+CONTAINS
+
+   SUBROUTINE p4z_int( kt )
+      !!---------------------------------------------------------------------
+      !!                     ***  ROUTINE p4z_int  ***
+      !!
+      !! ** Purpose :   interpolation and computation of various accessory fields
+      !!
+      !! ** Method  : - ???
+      !!---------------------------------------------------------------------
+      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index      
+      !!
+      INTEGER  ::   ji, jj
+      INTEGER  ::   iman, ivit1t, ivit2t
+      REAL(wp) ::   zpdtan, zman, zpdtmo, zdemi
+      REAL(wp) ::   zt, zdum
+      !!---------------------------------------------------------------------
+
       zpdtan = raass / rdt
-      nspyr  = nint(zpdtan)
       zman   = 12.
       iman   = 12
@@ -59 +53 @@
       zt     = ( float ( kt) + zdemi) / zpdtmo
       
-C  recherche de l'indice des enregistrements
-C  du modele dynamique encadrant le pas de temps kt.
-C  --------------------------------------------------
-C
-      xtvit = zt - float(int ( zt))
-      nvit1t = int (zt)
-      nvit2t = nvit1t+1
-      nvit1t = MOD ( nvit1t, iman)
-      IF ( nvit1t .EQ. 0 ) nvit1t = iman
-      nvit2t = MOD ( nvit2t, iman)
-      IF ( nvit2t .EQ. 0 ) nvit2t = iman
-C
-C Interpolation of dust deposition
-C --------------------------------
-C
-         dust(:,:) = (1.-xtvit)*dustmo(:,:,nvit1t)
-     $            +xtvit*dustmo(:,:,nvit2t)
-C
-C
-C Computation of phyto and zoo metabolic rate
-C -------------------------------------------
-C
+      !  recherche de l indice des enregistrements
+      !  du modele dynamique encadrant le pas de temps kt.
+      !  --------------------------------------------------
 
-         Tgfunc(:,:,:) = exp(0.063913*tn(:,:,:))
-         Tgfunc2(:,:,:) = exp(0.07608*tn(:,:,:))
-C
-C      Computation of the silicon dependant half saturation
-C      constant for silica uptake
-C       ---------------------------------------------------
-C
-        DO ji=1,jpi
-          DO jj=1,jpj
-          zdum=trn(ji,jj,1,jpsil)**2
-          xksimax(ji,jj) = max(xksimax(ji,jj),(1.+7.*zdum
-     &      /(xksi2*xksi2*25.+zdum))*1E-6)
-          END DO
-        END DO
-C
-        IF (nday_year.EQ.365) THEN
-           xksi=xksimax
-           xksimax=0.
-        ENDIF
-C
-#endif
-C
-      RETURN
-      END
+      xtvit = zt - FLOAT( INT( zt ) )
+      ivit1t = INT( zt )
+      ivit2t = ivit1t + 1
+      ivit1t = MOD ( ivit1t, iman )
+      IF( ivit1t == 0 )   ivit1t = iman
+      ivit2t = MOD ( ivit2t, iman )
+      IF( ivit2t == 0 )   ivit2t = iman
+
+      ! Interpolation of dust deposition
+      ! --------------------------------
+
+      dust(:,:) = ( 1.- xtvit ) * dustmo(:,:,ivit1t) + xtvit * dustmo(:,:,ivit2t)
+
+      ! Computation of phyto and zoo metabolic rate
+      ! -------------------------------------------
+
+      Tgfunc (:,:,:) = EXP( 0.063913 * tn(:,:,:) )
+      Tgfunc2(:,:,:) = EXP( 0.07608  * tn(:,:,:) )
+
+      ! Computation of the silicon dependant half saturation
+      ! constant for silica uptake
+      ! ---------------------------------------------------
+
+      DO ji = 1, jpi
+         DO jj = 1, jpj
+            zdum = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil)
+            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zdum / ( xksi2 * xksi2 * 25. + zdum ) ) * 1e-6 )
+         END DO
+      END DO
+
+      IF( nday_year == 365 ) THEN
+         xksi    = xksimax
+         xksimax = 0.e0
+      ENDIF
+      !
+   END SUBROUTINE p4z_int
+
+#else
+   !!======================================================================
+   !!  Dummy module :                                   No PISCES bio-model
+   !!======================================================================
+CONTAINS
+   SUBROUTINE p4z_int( kt )                   ! Empty routine
+      INTEGER, INTENT( in ) ::   kt
+      WRITE(*,*) 'p4z_int: You should not have seen this print! error?', kt
+   END SUBROUTINE p4z_int
+#endif 
+
+   !!======================================================================
+END MODULE  p4zint