New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2715 for trunk/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2011-03-30T17:58:35+02:00 (13 years ago)
Author:
rblod
Message:

First attempt to put dynamic allocation on the trunk

Location:
trunk/NEMOGCM/NEMO/TOP_SRC
Files:
54 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r2528 r2715  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2008-12  (C. Ethe, G. Madec)  revised architecture 
    7    !!---------------------------------------------------------------------- 
    8    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    9    !! $Id$  
    10    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    117   !!---------------------------------------------------------------------- 
    128   USE par_lobster, ONLY : jp_lobster      !: number of tracers in LOBSTER 
     
    5551 
    5652   ! Starting/ending C14 do-loop indices (N.B. no C14 : jp_c14b0 > jp_c14b1 the do-loop are never done) 
    57    INTEGER, PUBLIC, PARAMETER ::   jp_c14b0     = jp_lb + 1                !: First index of C14 tracer 
    58    INTEGER, PUBLIC, PARAMETER ::   jp_c14b1     = jp_lb + jp_c14b          !: Last  index of C14 tracer 
     53   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0     = jp_lb     + 1            !: First index of C14 tracer 
     54   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1     = jp_lb     + jp_c14b      !: Last  index of C14 tracer 
    5955   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_2d  = jp_lb_2d  + 1            !: First index of C14 tracer 
    6056   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_2d  = jp_lb_2d  + jp_c14b_2d   !: Last  index of C14 tracer 
     
    6460   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_trd = jp_lb_trd + jp_c14b_trd  !: Last  index of C14 tracer 
    6561 
     62   !!---------------------------------------------------------------------- 
     63   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     64   !! $Id$  
     65   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6666   !!====================================================================== 
    6767END MODULE par_c14b 
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2528 r2715  
    44   !! TOP :   initialisation of the C14 bomb tracer 
    55   !!====================================================================== 
    6    !! History : Original ! 2005-10  (Z. Lachkar)  
    7    !!               2.0  ! 2007-12  (C. Ethe )  
     6   !! History :  1.0  ! 2005-10  (Z. Lachkar) Original code 
     7   !!            2.0  ! 2007-12  (C. Ethe)  
    88   !!---------------------------------------------------------------------- 
    99#if defined key_c14b 
     
    1717   USE trc             ! TOP variables 
    1818   USE trcsms_c14b     ! C14 sms trends 
    19    USE in_out_manager  ! I/O manager 
    2019 
    2120   IMPLICIT NONE 
     
    2423   PUBLIC   trc_ini_c14b   ! called by trcini.F90 module 
    2524 
    26    INTEGER  ::   &     ! With respect to data file !! 
    27      jpybeg = 1765 , & !: starting year for C14 
    28      jpyend = 2002     !: ending year for C14 
    29  
    30    INTEGER  ::   &    
    31       nrec   ,  & ! number of year in CO2 Concentrations file 
    32       nmaxrec  
    33  
    34    INTEGER  ::   inum1, inum2               ! unit number 
    35  
    36    REAL(wp) ::     & 
    37      ys40 = -40. ,    &             ! 40 degrees south 
    38      ys20 = -20. ,    &             ! 20 degrees south 
    39      yn20 =  20. ,    &             ! 20 degrees north 
    40      yn40 =  40.                    ! 40 degrees north 
    41  
    42    !!--------------------------------------------------------------------- 
     25   !                             ! With respect to data file !! 
     26   INTEGER  ::   jpybeg = 1765   ! starting year for C14 
     27   INTEGER  ::   jpyend = 2002   ! ending year for C14 
     28   INTEGER  ::   nrec            ! number of year in CO2 Concentrations file 
     29   INTEGER  ::   nmaxrec  
     30   INTEGER  ::   inum1, inum2    ! unit number 
     31 
     32   REAL(wp) ::   ys40 = -40.     ! 40 degrees south 
     33   REAL(wp) ::   ys20 = -20.     ! 20 degrees south 
     34   REAL(wp) ::   yn20 =  20.     ! 20 degrees north 
     35   REAL(wp) ::   yn40 =  40.     ! 40 degrees north 
     36 
     37   !!---------------------------------------------------------------------- 
    4338   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4439   !! $Id$  
    45    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    46    !!---------------------------------------------------------------------- 
    47  
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4842CONTAINS 
    4943 
     
    5953      !!---------------------------------------------------------------------- 
    6054 
    61       !  Control consitency 
    62       CALL trc_ctl_c14b 
     55      !                     ! Allocate C14b arrays 
     56      IF( trc_sms_c14b_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' ) 
     57 
     58      CALL trc_ctl_c14b     !  Control consitency 
    6359 
    6460      IF(lwp) WRITE(numout,*) '' 
     
    6965      ! Initialization of boundaries conditions 
    7066      ! ---------------------------------------  
    71       qtr_c14(:,:) = 0.e0 
     67      qtr_c14(:,:) = 0._wp 
    7268       
    7369      ! Initialization of qint in case of  no restart  
     
    7874            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
    7975         ENDIF 
    80          trn     (:,:,:,jpc14) = 0.e0 
    81          qint_c14(:,:        ) = 0.e0 
     76         trn     (:,:,:,jpc14) = 0._wp 
     77         qint_c14(:,:        ) = 0._wp 
    8278      ENDIF 
    8379 
     
    156152                 fareaz(ji,jj,3) = 0. 
    157153            ENDIF 
    158           END DO 
    159         END DO 
    160  
     154         END DO 
     155      END DO 
    161156      ! 
    162157      IF(lwp) WRITE(numout,*) 'Initialization of C14 bomb tracer done' 
    163158      IF(lwp) WRITE(numout,*) ' ' 
    164  
     159      ! 
    165160   END SUBROUTINE trc_ini_c14b 
    166     
     161 
     162 
    167163   SUBROUTINE trc_ctl_c14b 
    168164      !!---------------------------------------------------------------------- 
     
    179175      ! Check number of tracers 
    180176      ! -----------------------    
    181       IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 
     177      IF( jp_c14b > 1)   CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 
    182178 
    183179      ! Check tracer names 
    184180      ! ------------------ 
    185       IF ( ctrcnm(jpc14) /= 'C14B' ) THEN 
    186            ctrcnm(jpc14)  = 'C14B' 
    187            ctrcnl(jpc14)  = 'Bomb C14 concentration' 
     181      IF( ctrcnm(jpc14) /= 'C14B' ) THEN 
     182          ctrcnm(jpc14)  = 'C14B' 
     183          ctrcnl(jpc14)  = 'Bomb C14 concentration' 
    188184      ENDIF 
    189185 
     
    197193      ! ------------------ 
    198194      IF( ctrcun(jpc14) /= 'ration' ) THEN 
    199           ctrcun(jpc14) = 'ration' 
     195          ctrcun(jpc14)  = 'ration' 
    200196          IF(lwp) THEN 
    201197             CALL ctl_warn( ' we force tracer unit' ) 
     
    206202      ! 
    207203   END SUBROUTINE trc_ctl_c14b 
     204    
    208205#else 
    209206   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

    r2567 r2715  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_c14b     ! C14b specific variable 
    18    USE in_out_manager  ! I/O manager 
    1918 
    2019   IMPLICIT NONE 
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcrst_c14b.F90

    r2528 r2715  
    1717   USE trc             ! TOP variables 
    1818   USE trcsms_c14b          ! c14b sms trends 
    19    USE in_out_manager  ! I/O manager 
    2019   USE iom 
    2120 
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2528 r2715  
    44   !! TOP : Bomb C14 main module 
    55   !!====================================================================== 
    6    !! History     -   ! 1994-05 ( J. Orr ) origial code 
     6   !! History     -   ! 1994-05 ( J. Orr ) original code 
    77   !!            1.0  ! 2006-02 ( J.M. Molines )  Free form + modularity 
    88   !!            2.0  ! 2008-12 ( C. Ethe ) reorganisation 
     9   !!            4.0  ! 2011-02 ( A.R. Porter, STFC Daresbury ) Dynamic memory 
    910   !!---------------------------------------------------------------------- 
    1011#if defined key_c14b 
     
    1213   !!   'key_c14b'                                         Bomb C14 tracer 
    1314   !!---------------------------------------------------------------------- 
    14    !!   trc_sms_c14b  :  compute and add C14 suface forcing to C14 trends 
    15    !!---------------------------------------------------------------------- 
    16    USE oce_trc      ! Ocean variables 
    17    USE par_trc      ! TOP parameters 
    18    USE trc          ! TOP variables 
     15   !!   trc_sms_c14b :  compute and add C14 suface forcing to C14 trends 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc       ! Ocean variables 
     18   USE par_trc       ! TOP parameters 
     19   USE trc           ! TOP variables 
    1920   USE trdmod_oce 
    2021   USE trdmod_trc 
    21    USE iom 
     22   USE iom           ! I/O library 
    2223 
    2324   IMPLICIT NONE 
    2425   PRIVATE 
    2526 
    26    !! * Routine accessibility 
    27    PUBLIC   trc_sms_c14b       ! called in ???     
    28  
    29    !! * Module variables 
     27   PUBLIC   trc_sms_c14b       ! called in trcsms.F90 
     28   PUBLIC   trc_sms_c14b_alloc ! called in trcini_c14b.F90 
     29 
    3030   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec  = 240           ! temporal parameter  
    3131   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec2 = 2 * jpmaxrec  !  
     
    3737   INTEGER , PUBLIC    ::   nyear_beg        ! initial year (aa)  
    3838 
    39    REAL(wp), PUBLIC, DIMENSION(jpmaxrec,jpzon) ::  bomb   !: C14 atm data (3 zones) 
    40    REAL(wp), PUBLIC, DIMENSION(jpi,jpj ,jpzon) ::  fareaz !: Spatial Interpolation Factors 
    41    REAL(wp), PUBLIC, DIMENSION(jpmaxrec2)      ::  spco2  !: Atmospheric CO2 
     39   REAL(wp), PUBLIC,                    DIMENSION(jpmaxrec,jpzon) ::   bomb       !: C14 atm data (3 zones) 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)          ::   fareaz    !: Spatial Interpolation Factors 
     41   REAL(wp), PUBLIC,                    DIMENSION(jpmaxrec2)      ::   spco2      !: Atmospheric CO2 
    4242   
    43    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   qtr_c14      !: flux at surface 
    44    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   qint_c14     !: cumulative flux 
    45  
    46    REAL(wp) :: xlambda, xdecay, xaccum       ! C14 decay coef.   
    47  
    48    REAL(wp) ::   xconv1 = 1.0          ! conversion from to  
    49    REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:  
    50    REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm 
    51  
    52   !! * Substitutions 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)            ::   qtr_c14    !: flux at surface 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)            ::   qint_c14   !: cumulative flux 
     45 
     46   REAL(wp) ::   xlambda, xdecay, xaccum       ! C14 decay coef.   
     47   REAL(wp) ::   xconv1 = 1._wp                ! conversion from to  
     48   REAL(wp) ::   xconv2 = 0.01_wp / 3600._wp   ! conversion from cm/h to m/s:  
     49   REAL(wp) ::   xconv3 = 1.e+3_wp             ! conversion from mol/l/atm to mol/m3/atm 
     50 
     51   !! * Substitutions 
    5352#  include "top_substitute.h90" 
    5453 
    55   !!---------------------------------------------------------------------- 
    56   !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    57   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $  
    58   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    59   !!---------------------------------------------------------------------- 
    60  
     54   !!---------------------------------------------------------------------- 
     55   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     56   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $  
     57   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     58   !!---------------------------------------------------------------------- 
    6159CONTAINS 
    6260 
    63   SUBROUTINE trc_sms_c14b( kt ) 
    64      !!---------------------------------------------------------------------- 
    65      !!                  ***  ROUTINE trc_sms_c14b  *** 
    66      !! 
    67      !! ** Purpose :   Compute the surface boundary contition on C14bomb 
    68      !!      passive tracer associated with air-mer fluxes and add it to  
    69      !!      the general trend of tracers equations. 
    70      !! 
    71      !! ** Original comments from J. Orr : 
    72      !! 
    73      !!      Calculates the input of Bomb C-14 to the surface layer of OPA 
    74      !! 
    75      !!      James Orr, LMCE, 28 October 1992 
    76      !! 
    77      !!      Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989) 
    78      !!      (hereafter referred to as TDB) with constant gas exchange, 
    79      !!      although in this case, a perturbation approach is used for 
    80      !!      bomb-C14 so that both the ocean and atmosphere begin at zero. 
    81      !!      This saves tremendous amounts of computer time since no 
    82      !!      equilibrum run is first required (i.e., for natural C-14). 
    83      !!      Note: Many sensitivity tests can be run with this approach and 
    84      !!            one never has to make a run for natural C-14; otherwise, 
    85      !!            a run for natural C-14 must be run each time that one 
    86      !!            changes a model parameter! 
    87      !! 
    88      !! 
    89      !!      19 August 1993: Modified to consider Atmospheric C-14 fom IPCC. 
    90      !!      That is, the IPCC has provided a C-14 atmospheric record (courtesy 
    91      !!      of Martin Heimann) for model calibration.  This model spans from 
    92      !!      preindustrial times to present, in a format different than that 
    93      !!      given by TDB.  It must be converted to the ORR C-14 units used 
    94      !!      here, although in this case, the perturbation includes not only 
    95      !!      bomb C-14 but changes due to the Suess effect. 
    96      !! 
    97      !!---------------------------------------------------------------------- 
    98      !! * Arguments 
    99      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    100  
    101      !! * Local declarations 
    102      INTEGER ::  & 
    103        ji, jj, jk, jz 
    104  
    105      INTEGER ::   & 
    106        iyear_beg,              & 
    107        iyear_beg1, iyear_end1, & 
    108        imonth1, im1, im2,      & 
    109        iyear_beg2, iyear_end2, & 
    110        imonth2, in1, in2 
    111           
    112      REAL(wp), DIMENSION(jpi,jpj) ::  &  
    113        zatmbc14 
    114  
    115      REAL(wp), DIMENSION(jpzon)   ::  & 
    116        zonbc14              !: time interp atm C14 
    117  
    118      REAL(wp) ::     & 
    119        zpco2at              !: time interp atm C02 
    120  
    121      REAL(wp) ::     &      !: dummy variables 
    122        zt, ztp, zsk, & 
    123        zsol ,        &      !: solubility 
    124        zsch ,        &      !: schmidt number 
    125        zv2  ,        &      !: wind speed ( square) 
    126        zpv  ,        &      !: piston velocity  
    127        zdemi, ztra 
    128 #if defined key_diatrc  && defined key_iomput 
    129       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d 
    130 #endif 
    131       !!---------------------------------------------------------------------- 
    132  
    133       IF( kt == nit000 )  THEN 
    134          ! Computation of decay coeffcient 
    135          zdemi   = 5730. 
     61   SUBROUTINE trc_sms_c14b( kt ) 
     62      !!---------------------------------------------------------------------- 
     63      !!                  ***  ROUTINE trc_sms_c14b  *** 
     64      !! 
     65      !! ** Purpose :   Compute the surface boundary contition on C14bomb 
     66      !!      passive tracer associated with air-mer fluxes and add it to  
     67      !!      the general trend of tracers equations. 
     68      !! 
     69      !! ** Original comments from J. Orr : 
     70      !! 
     71      !!      Calculates the input of Bomb C-14 to the surface layer of OPA 
     72      !! 
     73      !!      James Orr, LMCE, 28 October 1992 
     74      !! 
     75      !!      Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989) 
     76      !!      (hereafter referred to as TDB) with constant gas exchange, 
     77      !!      although in this case, a perturbation approach is used for 
     78      !!      bomb-C14 so that both the ocean and atmosphere begin at zero. 
     79      !!      This saves tremendous amounts of computer time since no 
     80      !!      equilibrum run is first required (i.e., for natural C-14). 
     81      !!      Note: Many sensitivity tests can be run with this approach and 
     82      !!            one never has to make a run for natural C-14; otherwise, 
     83      !!            a run for natural C-14 must be run each time that one 
     84      !!            changes a model parameter! 
     85      !! 
     86      !! 
     87      !!      19 August 1993: Modified to consider Atmospheric C-14 fom IPCC. 
     88      !!      That is, the IPCC has provided a C-14 atmospheric record (courtesy 
     89      !!      of Martin Heimann) for model calibration.  This model spans from 
     90      !!      preindustrial times to present, in a format different than that 
     91      !!      given by TDB.  It must be converted to the ORR C-14 units used 
     92      !!      here, although in this case, the perturbation includes not only 
     93      !!      bomb C-14 but changes due to the Suess effect. 
     94      !! 
     95      !!---------------------------------------------------------------------- 
     96      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     97      USE wrk_nemo, ONLY:   zatmbc14 => wrk_2d_1 
     98      USE wrk_nemo, ONLY:   zw3d     => wrk_3d_1 
     99      ! 
     100      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     101      ! 
     102      INTEGER :: ji, jj, jk, jz     ! dummy loop indices  
     103      INTEGER :: iyear_beg , iyear_beg1, iyear_end1  
     104      INTEGER :: iyear_beg2, iyear_end2  
     105      INTEGER :: imonth1, im1, in1  
     106      INTEGER :: imonth2, im2, in2  
     107      REAL(wp), DIMENSION(jpzon) :: zonbc14       !: time interp atm C14  
     108      REAL(wp)                   :: zpco2at       !: time interp atm C02  
     109      REAL(wp) :: zt, ztp, zsk      ! dummy variables 
     110      REAL(wp) :: zsol              ! solubility 
     111      REAL(wp) :: zsch              ! schmidt number 
     112      REAL(wp) :: zv2               ! wind speed ( square) 
     113      REAL(wp) :: zpv               ! piston velocity  
     114      REAL(wp) :: zdemi, ztra 
     115      !!---------------------------------------------------------------------- 
     116 
     117      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 
     118         CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable')   ;   RETURN 
     119      ENDIF 
     120 
     121      IF( kt == nit000 )  THEN         ! Computation of decay coeffcient 
     122         zdemi   = 5730._wp 
    136123         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) 
    137124         xdecay  = EXP( - xlambda * rdt ) 
    138          xaccum  = 1.0 -  xdecay 
     125         xaccum  = 1._wp -  xdecay 
    139126      ENDIF 
    140127 
     
    206193      !  (zonmean), computes area-weighted mean to give the atmospheric C-14 
    207194      !  ---------------------------------------------------------------- 
    208       DO jj = 1, jpj 
    209          DO ji = 1, jpi 
    210             zatmbc14(ji,jj) =   zonbc14(1) * fareaz(ji,jj,1)  & 
    211                  &           +  zonbc14(2) * fareaz(ji,jj,2)  & 
    212                  &           +  zonbc14(3) * fareaz(ji,jj,3) 
    213          END DO 
    214       END DO 
     195      zatmbc14(:,:) = zonbc14(1) * fareaz(:,:,1)   & 
     196         &          + zonbc14(2) * fareaz(:,:,2)   & 
     197         &          + zonbc14(3) * fareaz(:,:,3) 
    215198       
    216199      ! time interpolation of CO2 concentrations to it time step   
     
    218201           &     + spco2(iyear_end2) * FLOAT( in2 ) ) / 6. 
    219202 
    220       IF (lwp) THEN 
     203      IF(lwp) THEN 
    221204          WRITE(numout, *) 'time : ', kt, ' CO2 year begin/end :',iyear_beg2,'/',iyear_end2,   & 
    222205          &                ' CO2 concen : ',zpco2at  
     
    238221               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 
    239222               ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)] 
    240                zsol = zsol * 1.0e-03 
     223               zsol = zsol * 1.e-03 
    241224            ELSE 
    242                zsol = 0. 
     225               zsol = 0._wp 
    243226            ENDIF 
    244227 
     
    307290      CALL iom_put( "fdecay" , zw3d ) 
    308291#endif 
    309       IF( l_trdtrc ) THEN 
    310          CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
    311       END IF 
    312  
    313     END SUBROUTINE trc_sms_c14b 
     292      IF( l_trdtrc )   CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
     293 
     294      IF( wrk_not_released(2, 1) .OR.   & 
     295          wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays') 
     296      ! 
     297   END SUBROUTINE trc_sms_c14b 
     298 
     299 
     300   INTEGER FUNCTION trc_sms_c14b_alloc() 
     301      !!---------------------------------------------------------------------- 
     302      !!                  ***  ROUTINE trc_sms_c14b_alloc  *** 
     303      !!---------------------------------------------------------------------- 
     304      ALLOCATE( fareaz  (jpi,jpj ,jpzon) ,     & 
     305         &      qtr_c14 (jpi,jpj)        ,     & 
     306         &      qint_c14(jpi,jpj)        , STAT=trc_sms_c14b_alloc ) 
     307         ! 
     308      IF( trc_sms_c14b_alloc /= 0 )   CALL ctl_warn('trc_sms_c14b_alloc: failed to allocate arrays') 
     309      ! 
     310   END FUNCTION trc_sms_c14b_alloc 
    314311 
    315312#else 
    316     !!---------------------------------------------------------------------- 
    317     !!   Default option                                         Dummy module 
    318     !!---------------------------------------------------------------------- 
     313   !!---------------------------------------------------------------------- 
     314   !!   Default option                                         Dummy module 
     315   !!---------------------------------------------------------------------- 
    319316CONTAINS 
    320   SUBROUTINE trc_sms_c14b( kt )       ! Empty routine 
    321     WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt 
    322   END SUBROUTINE trc_sms_c14b 
     317   SUBROUTINE trc_sms_c14b( kt )       ! Empty routine 
     318      WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt 
     319   END SUBROUTINE trc_sms_c14b 
    323320#endif 
    324321 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r2528 r2715  
    1515   USE par_trc         ! TOP parameters 
    1616   USE trc             ! TOP variables 
    17    USE trcsms_cfc          ! CFC sms trends 
    18    USE in_out_manager  ! I/O manager 
     17   USE trcsms_cfc      ! CFC sms trends 
    1918 
    2019   IMPLICIT NONE 
     
    3433   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3534   !!---------------------------------------------------------------------- 
    36  
    3735CONTAINS 
    3836 
     
    4543      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    4644      !!---------------------------------------------------------------------- 
    47       INTEGER  ::   ji, jj, jn, jl, jm, js 
    48       REAL(wp) ::   zyy  , zyd 
     45      INTEGER  ::  ji, jj, jn, jl, jm, js 
     46      REAL(wp) ::  zyy, zyd 
    4947      !!---------------------------------------------------------------------- 
    5048 
     
    5351      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    5452 
     53      !                                ! Allocate CFC arrays 
     54      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' ) 
     55 
    5556 
    5657      ! Initialization of boundaries conditions 
    5758      ! ---------------------------------------  
    58       xphem (:,:)    = 0.e0 
    59       p_cfc(:,:,:)   = 0.e0 
     59      xphem (:,:)    = 0._wp 
     60      p_cfc(:,:,:)   = 0._wp 
    6061       
    6162      ! Initialization of qint in case of  no restart  
    6263      !---------------------------------------------- 
    63       qtr_cfc(:,:,:) = 0.e0 
     64      qtr_cfc(:,:,:) = 0._wp 
    6465      IF( .NOT. ln_rsttr ) THEN     
    6566         IF(lwp) THEN 
     
    6768            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
    6869         ENDIF 
    69          qint_cfc(:,:,:) = 0.e0 
     70         qint_cfc(:,:,:) = 0._wp 
    7071         DO jl = 1, jp_cfc 
    7172            jn = jp_cfc0 + jl - 1 
    72             trn     (:,:,:,jn) = 0.e0 
     73            trn(:,:,:,jn) = 0._wp 
    7374         END DO 
    7475      ENDIF 
     
    116117         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
    117118         DO jn = 30, 100 
    118             WRITE(numout, '( 1I4, 4F9.2)')   & 
    119                &         jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
     119            WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
    120120         END DO 
    121121      ENDIF 
     
    135135      END DO 
    136136      ! 
    137  
    138137      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done' 
    139138      IF(lwp) WRITE(numout,*) ' ' 
    140  
     139      ! 
    141140   END SUBROUTINE trc_ini_cfc 
    142141    
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r2567 r2715  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_cfc      ! CFC specific variable 
    18    USE in_out_manager  ! I/O manager 
    1918 
    2019   IMPLICIT NONE 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcrst_cfc.F90

    r2528 r2715  
    1717   USE trc             ! TOP variables 
    1818   USE trcsms_cfc          ! CFC sms trends 
    19    USE in_out_manager  ! I/O manager 
    2019   USE iom 
    2120 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2528 r2715  
    44   !! TOP : CFC main model 
    55   !!====================================================================== 
    6    !! History :    -   !  1999-10  (JC. Dutay)  original code 
    7    !!             1.0  !  2004-03 (C. Ethe) free form + modularity 
    8    !!             2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
     6   !! History :  OPA  !  1999-10  (JC. Dutay)  original code 
     7   !!  NEMO      1.0  !  2004-03 (C. Ethe) free form + modularity 
     8   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
    99   !!---------------------------------------------------------------------- 
    1010#if defined key_cfc 
     
    1212   !!   'key_cfc'                                               CFC tracers 
    1313   !!---------------------------------------------------------------------- 
    14    !!   trc_sms_cfc     :  compute and add CFC suface forcing to CFC trends 
    15    !!   trc_cfc_cst :  sets constants for CFC surface forcing computation 
    16    !!---------------------------------------------------------------------- 
    17    USE oce_trc      ! Ocean variables 
    18    USE par_trc      ! TOP parameters 
    19    USE trc          ! TOP variables 
     14   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends 
     15   !!   trc_cfc_cst  :  sets constants for CFC surface forcing computation 
     16   !!---------------------------------------------------------------------- 
     17   USE oce_trc       ! Ocean variables 
     18   USE par_trc       ! TOP parameters 
     19   USE trc           ! TOP variables 
    2020   USE trdmod_oce 
    2121   USE trdmod_trc 
    22    USE iom 
     22   USE iom           ! I/O library 
    2323 
    2424   IMPLICIT NONE 
    2525   PRIVATE 
    2626 
    27    PUBLIC   trc_sms_cfc       ! called in ???     
     27   PUBLIC   trc_sms_cfc         ! called in ???     
     28   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90 
    2829 
    2930   INTEGER , PUBLIC, PARAMETER ::   jpyear = 150   ! temporal parameter  
     
    3435   INTEGER , PUBLIC    ::   npyear         ! Number of years read in CFC1112 file 
    3536    
    36    REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2    ) ::   p_cfc    ! partial hemispheric pressure for CFC           
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)              ::   xphem    ! spatial interpolation factor for patm 
    38    REAL(wp), PUBLIC, DIMENSION(jpi,jpj     ,jp_cfc) ::   qtr_cfc  ! flux at surface 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj     ,jp_cfc) ::   qint_cfc ! cumulative flux  
     37   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2    )      ::   p_cfc    ! partial hemispheric pressure for CFC 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux  
    4041 
    4142   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
     
    5455   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5556   !! $Id$  
    56    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    57    !!---------------------------------------------------------------------- 
    58  
     57   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     58   !!---------------------------------------------------------------------- 
    5959CONTAINS 
    6060 
     
    7575      !!                CFC concentration in pico-mol/m3 
    7676      !!---------------------------------------------------------------------- 
    77       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    78       !! 
    79       INTEGER ::   ji, jj, jn, jl, jm, js 
    80       INTEGER ::   iyear_beg, iyear_end 
    81       INTEGER ::   im1, im2 
    82  
     77      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     78      USE wrk_nemo, ONLY:   ztrcfc => wrk_3d_1        ! use for CFC sms trend 
     79      ! 
     80      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     81      ! 
     82      INTEGER  ::   ji, jj, jn, jl, jm, js 
     83      INTEGER  ::   iyear_beg, iyear_end 
     84      INTEGER  ::   im1, im2 
    8385      REAL(wp) ::   ztap, zdtap         
    8486      REAL(wp) ::   zt1, zt2, zt3, zv2 
     
    8890      REAL(wp) ::   zca_cfc   ! concentration at equilibrium 
    8991      REAL(wp) ::   zak_cfc   ! transfert coefficients 
    90  
    91       REAL(wp), DIMENSION(jphem,jp_cfc)   ::   zpatm       ! atmospheric function 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk)    ::   ztrcfc      ! use for CFC sms trend 
    93       !!---------------------------------------------------------------------- 
     92      REAL(wp), DIMENSION(jphem,jp_cfc) ::   zpatm   ! atmospheric function 
     93      !!---------------------------------------------------------------------- 
     94      ! 
     95      IF( wrk_in_use(3, 1) ) THEN 
     96         CALL ctl_stop('trc_sms_cfc: requested workspace array unavailable')   ;   RETURN 
     97      ENDIF 
    9498 
    9599      IF( kt == nit000 )   CALL trc_cfc_cst 
     
    175179#if defined key_diatrc  
    176180      ! Save diagnostics , just for CFC11 
    177 # if ! defined key_iomput 
     181# if  defined key_iomput 
     182      CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     183      CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     184# else 
    178185      trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    179186      trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    180 # else 
    181       CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    182       CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    183187# endif 
    184188#endif 
     
    190194          END DO 
    191195      END IF 
    192  
     196      ! 
     197      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_cfc: failed to release workspace array') 
     198      ! 
    193199   END SUBROUTINE trc_sms_cfc 
     200 
    194201 
    195202   SUBROUTINE trc_cfc_cst 
     
    200207      !!--------------------------------------------------------------------- 
    201208 
    202  
    203         ! coefficient for CFC11  
    204         !---------------------- 
    205  
    206         ! Solubility 
    207         soa(1,1) = -229.9261  
    208         soa(2,1) =  319.6552 
    209         soa(3,1) =  119.4471 
    210         soa(4,1) =  -1.39165 
    211  
    212         sob(1,1) =  -0.142382 
    213         sob(2,1) =   0.091459 
    214         sob(3,1) =  -0.0157274 
    215  
    216         ! Schmidt number  
    217         sca(1,1) = 3501.8 
    218         sca(2,1) = -210.31 
    219         sca(3,1) =  6.1851 
    220         sca(4,1) = -0.07513 
    221  
    222         ! coefficient for CFC12  
    223         !---------------------- 
    224  
    225         ! Solubility 
    226         soa(1,2) = -218.0971 
    227         soa(2,2) =  298.9702 
    228         soa(3,2) =  113.8049 
    229         soa(4,2) =  -1.39165 
    230  
    231         sob(1,2) =  -0.143566 
    232         sob(2,2) =   0.091015 
    233         sob(3,2) =  -0.0153924 
    234  
    235         ! schmidt number  
    236         sca(1,2) =  3845.4  
    237         sca(2,2) =  -228.95 
    238         sca(3,2) =  6.1908  
    239         sca(4,2) =  -0.067430 
     209      ! coefficient for CFC11  
     210      !---------------------- 
     211 
     212      ! Solubility 
     213      soa(1,1) = -229.9261  
     214      soa(2,1) =  319.6552 
     215      soa(3,1) =  119.4471 
     216      soa(4,1) =  -1.39165 
     217 
     218      sob(1,1) =  -0.142382 
     219      sob(2,1) =   0.091459 
     220      sob(3,1) =  -0.0157274 
     221 
     222      ! Schmidt number  
     223      sca(1,1) = 3501.8 
     224      sca(2,1) = -210.31 
     225      sca(3,1) =  6.1851 
     226      sca(4,1) = -0.07513 
     227 
     228      ! coefficient for CFC12  
     229      !---------------------- 
     230 
     231      ! Solubility 
     232      soa(1,2) = -218.0971 
     233      soa(2,2) =  298.9702 
     234      soa(3,2) =  113.8049 
     235      soa(4,2) =  -1.39165 
     236 
     237      sob(1,2) =  -0.143566 
     238      sob(2,2) =   0.091015 
     239      sob(3,2) =  -0.0153924 
     240 
     241      ! schmidt number  
     242      sca(1,2) =  3845.4  
     243      sca(2,2) =  -228.95 
     244      sca(3,2) =  6.1908  
     245      sca(4,2) =  -0.067430 
    240246 
    241247   END SUBROUTINE trc_cfc_cst 
    242     
     248 
     249 
     250   INTEGER FUNCTION trc_sms_cfc_alloc() 
     251      !!---------------------------------------------------------------------- 
     252      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
     253      !!---------------------------------------------------------------------- 
     254      ALLOCATE( xphem   (jpi,jpj)        ,     & 
     255         &      qtr_cfc (jpi,jpj,jp_cfc) ,     & 
     256         &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 
     257         ! 
     258      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
     259      ! 
     260   END FUNCTION trc_sms_cfc_alloc 
     261 
    243262#else 
    244263   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90

    r2528 r2715  
    44   !! TOP :   LOBSTER 1 Source Minus Sink variables 
    55   !!---------------------------------------------------------------------- 
    6    !! History :    -   !  1999-09 (M. Levy)  original code 
    7    !!              -   !  2000-12 (O. Aumont, E. Kestenare) add sediment  
    8    !!             1.0  !  2005-10 (C. Ethe) F90 
    9    !!             1.0  !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 
    10    !!              -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca 
    11    !!             2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules 
     6   !! History :  OPA  !  1999-09 (M. Levy)  original code 
     7   !!             -   !  2000-12 (O. Aumont, E. Kestenare) add sediment  
     8   !!   NEMO     1.0  !  2005-10 (C. Ethe) F90 
     9   !!             -   !  2005-03  (A-S Kremeur) add fphylab, fzoolab, fdetlab, fdbod 
     10   !!             -   !  2005-06  (A-S Kremeur) add sedpocb, sedpocn, sedpoca 
     11   !!            2.0  !  2007-04  (C. Deltel, G. Madec) Free form and modules 
    1212   !!---------------------------------------------------------------------- 
    13  
    1413#if defined key_lobster 
    1514   !!---------------------------------------------------------------------- 
    1615   !!   'key_lobster'                                         LOBSTER model 
    1716   !!---------------------------------------------------------------------- 
    18    USE par_oce 
    19    USE par_trc 
     17   USE par_oce    ! ocean parameters 
     18   USE par_trc    ! passive tracer parameters 
     19   USE lib_mpp    ! MPP library 
    2020 
    2121   IMPLICIT NONE 
    2222   PUBLIC 
    2323 
    24    !!---------------------------------------------------------------------- 
    25    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    26    !! $Id$  
    27    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    28    !!---------------------------------------------------------------------- 
     24   PUBLIC   sms_lobster_alloc   ! called in trcini_lobster.F90 
    2925 
    3026   !!  biological parameters 
     
    7672   REAL(wp) ::   fdbod    !: zooplankton mortality fraction that goes to detritus 
    7773 
    78    REAL(wp), DIMENSION(jpk,jp_lobster) ::   remdmp   !: depth dependant damping coefficient of passive tracers  
     74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   remdmp   !: depth dependant damping coefficient of passive tracers  
    7975    
    8076   !! Optical parameters                                 
    8177   !! ------------------                                 
    82    REAL(wp) ::   xkr0       !: water coefficient absorption in red      (NAMELIST) 
    83    REAL(wp) ::   xkg0       !: water coefficient absorption in green    (NAMELIST) 
    84    REAL(wp) ::   xkrp       !: pigment coefficient absorption in red    (NAMELIST) 
    85    REAL(wp) ::   xkgp       !: pigment coefficient absorption in green  (NAMELIST) 
    86    REAL(wp) ::   xlr        !: exposant for pigment absorption in red   (NAMELIST) 
    87    REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST) 
    88    REAL(wp) ::   rpig       !: chla/chla+phea ratio                     (NAMELIST) 
     78   REAL(wp) ::   xkr0     !: water coefficient absorption in red      (NAMELIST) 
     79   REAL(wp) ::   xkg0     !: water coefficient absorption in green    (NAMELIST) 
     80   REAL(wp) ::   xkrp     !: pigment coefficient absorption in red    (NAMELIST) 
     81   REAL(wp) ::   xkgp     !: pigment coefficient absorption in green  (NAMELIST) 
     82   REAL(wp) ::   xlr      !: exposant for pigment absorption in red   (NAMELIST) 
     83   REAL(wp) ::   xlg      !: exposant for pigment absorption in green (NAMELIST) 
     84   REAL(wp) ::   rpig     !: chla/chla+phea ratio                     (NAMELIST) 
    8985                                                         
    90    INTEGER , DIMENSION(jpi,jpj)     ::   neln    !: number of levels in the euphotic layer 
    91    REAL(wp), DIMENSION(jpi,jpj)     ::   xze     !: euphotic layer depth 
    92    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xpar    !: par (photosynthetic available radiation) 
     86   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   neln   !: number of levels in the euphotic layer 
     87   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xze    !: euphotic layer depth 
     88   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xpar   !: par (photosynthetic available radiation) 
    9389 
    9490   !! Sediment parameters                                
     
    9894   REAL(wp) ::   areacot      !: ??? 
    9995                                                         
    100    REAL(wp), DIMENSION(jpi,jpj)     ::   dminl   !: fraction of sinking POC released in sediments 
    101    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dmin3   !: fraction of sinking POC released at each level 
     96   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dminl     !: fraction of sinking POC released in sediments 
     97   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dmin3     !: fraction of sinking POC released at each level 
    10298                                                         
    103    REAL(wp), DIMENSION(jpi,jpj) ::   sedpocb     !: mass of POC in sediments 
    104    REAL(wp), DIMENSION(jpi,jpj) ::   sedpocn     !: mass of POC in sediments 
    105    REAL(wp), DIMENSION(jpi,jpj) ::   sedpoca     !: mass of POC in sediments 
     99   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocb   !: mass of POC in sediments 
     100   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpocn   !: mass of POC in sediments 
     101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sedpoca   !: mass of POC in sediments 
    106102                                                         
    107    REAL(wp), DIMENSION(jpi,jpj) ::   fbod        !: rapid sinking particles 
    108    REAL(wp), DIMENSION(jpi,jpj) ::   cmask       !: ??? 
     103   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fbod      !: rapid sinking particles 
     104   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   cmask     !: ??? 
     105 
     106   !!---------------------------------------------------------------------- 
     107   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     108   !! $Id$  
     109   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     110   !!---------------------------------------------------------------------- 
     111CONTAINS 
     112 
     113   INTEGER FUNCTION sms_lobster_alloc() 
     114      !!---------------------------------------------------------------------- 
     115      !!        *** ROUTINE sms_lobster_alloc *** 
     116      !!---------------------------------------------------------------------- 
     117      ! 
     118      ALLOCATE(                                                                   & 
     119         !*  Biological parameters 
     120         &      remdmp(jpk,jp_lobster)                                      ,     & 
     121         !*  Optical parameters 
     122         &      neln   (jpi,jpj) , xze    (jpi,jpj)     , xpar(jpi,jpj,jpk) ,     & 
     123         !*  Sediment parameters 
     124         &      dminl  (jpi,jpj) , dmin3  (jpi,jpj,jpk)                     ,     & 
     125         &      sedpocb(jpi,jpj) , sedpocn(jpi,jpj)     , sedpoca(jpi,jpj)  ,     & 
     126         &      fbod   (jpi,jpj) , cmask  (jpi,jpj)                         , STAT=sms_lobster_alloc )  
     127         ! 
     128      IF( lk_mpp                 )   CALL mpp_sum ( sms_lobster_alloc ) 
     129      IF( sms_lobster_alloc /= 0 )   CALL ctl_warn('sms_lobster_alloc: failed to allocate arrays') 
     130      ! 
     131   END FUNCTION sms_lobster_alloc 
    109132 
    110133#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r2528 r2715  
    6060      !!              for passive tracers are saved for futher diagnostics. 
    6161      !!--------------------------------------------------------------------- 
     62      USE wrk_nemo, ONLY: wrk_in_use,  wrk_not_released 
     63      USE wrk_nemo, ONLY: wrk_3d_2, wrk_4d_1 
     64      !! 
    6265      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    6366      !! 
     
    7578#endif 
    7679#if defined key_diatrc && defined key_iomput 
    77       REAL(wp), DIMENSION(jpi,jpj,17)    :: zw2d 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zw3d 
     80      REAL(wp), POINTER,   DIMENSION(:,:,:) :: zw2d 
     81      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zw3d 
    7982#endif 
    8083      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrbio 
    8184      CHARACTER (len=25) :: charout 
    8285      !!--------------------------------------------------------------------- 
     86 
     87#if defined key_diatrc && defined key_iomput 
     88      IF( ( wrk_in_use(3, 2) ) .OR. ( wrk_in_use(4, 1) ) ) THEN 
     89         CALL ctl_stop('trc_bio : requested workspace arrays unavailable.') 
     90         RETURN 
     91      END IF 
     92      ! Set-up pointers into sub-arrays of workspaces 
     93      zw2d => wrk_3d_2(:,:,1:17) 
     94      zw3d => wrk_4d_1(:,:,:,1:3) 
     95#endif 
    8396 
    8497      IF( kt == nit000 ) THEN 
     
    90103      fbod(:,:) = 0.e0 
    91104#if defined key_diatrc && ! defined key_iomput 
     105#  if defined key_iomput 
     106      zw2d  (:,:,:) = 0.e0 
     107      zw3d(:,:,:,:) = 0.e0 
     108#  else 
    92109      DO jl = jp_lob0_2d, jp_lob1_2d 
    93110         trc2d(:,:,jl) = 0.e0 
    94111      END DO  
    95 #endif 
    96 #if defined key_diatrc && defined key_iomput 
    97       zw2d(:,:,:) = 0.e0 
    98       zw3d(:,:,:,:) = 0.e0 
     112#  endif 
    99113#endif 
    100114 
     
    485499         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    486500      ENDIF 
    487  
     501      ! 
     502#if defined key_diatrc && defined key_iomput 
     503      IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(4, 1) ) )  & 
     504        &   CALL ctl_stop('trc_bio : failed to release workspace arrays.') 
     505#endif 
     506      ! 
    488507   END SUBROUTINE trc_bio 
    489508 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r2528 r2715  
    101101            sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj)   & 
    102102               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
    103             zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj) 
     103            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
    104104         END DO 
    105105      END DO 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r2528 r2715  
    44   !! TOP :   initialisation of the LOBSTER biological model 
    55   !!====================================================================== 
    6    !! History :    -   !  1999-09  (M. Levy) Original code 
     6   !! History :   OPA  !  1999-09  (M. Levy) Original code 
    77   !!              -   !  2000-12  (0. Aumont, E. Kestenare) add sediment  
    8    !!             1.0  !  2004-03  (C. Ethe) Modularity 
     8   !!   NEMO      1.0  !  2004-03  (C. Ethe) Modularity 
    99   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    1010   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.lobster1.h90 
     
    2121   USE trc 
    2222   USE lbclnk  
    23    USE lib_mpp  
    24    USE lib_fortran  
    2523 
    2624   IMPLICIT NONE 
     
    3331   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3432   !! $Id$  
    35    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    36    !!---------------------------------------------------------------------- 
    37  
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     34   !!---------------------------------------------------------------------- 
    3835CONTAINS 
    3936 
     
    4340      !! ** purpose :   specific initialisation for LOBSTER bio-model 
    4441      !!---------------------------------------------------------------------- 
     42      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     43      USE wrk_nemo, ONLY:   zrro => wrk_2d_1 , zdm0 => wrk_3d_1 
     44      !! 
    4545      INTEGER  ::   ji, jj, jk, jn 
    4646      REAL(wp) ::   ztest, zfluo, zfluu 
    47       REAL(wp), DIMENSION(jpi,jpj)     ::   zrro 
    48       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdm0 
    4947      !!---------------------------------------------------------------------- 
    50  
    51       !  Control consitency 
    52       CALL trc_ctl_lobster 
    53  
     48      ! 
     49      IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 1)  )  THEN 
     50         CALL ctl_stop('trc_ini_lobster: requested workspace arrays unavailable')   ;  RETURN 
     51      ENDIF 
    5452 
    5553      IF(lwp) WRITE(numout,*) 
     
    5755      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    5856 
     57      !                                ! Allocate LOBSTER arrays 
     58      IF( sms_lobster_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_lobster: unable to allocate LOBSTER arrays' ) 
     59 
     60 
     61 
    5962      ! initialization of fields for optical model 
    6063      ! -------------------------------------------- 
    61       xze (:,:)   = 5.e0 
    62       xpar(:,:,:) = 0.e0 
     64      xze (:,:)   = 5._wp 
     65      xpar(:,:,:) = 0._wp 
    6366 
    6467      ! initialization for passive tracer remineralisation-damping  array 
     
    7073 
    7174      IF(lwp) THEN 
    72          WRITE(numout,*) ' ' 
    73          WRITE(numout,*) ' trcini: compute remineralisation-damping  ' 
    74          WRITE(numout,*) '         arrays for tracers' 
     75         WRITE(numout,*) 
     76         WRITE(numout,*) ' trcini: compute remineralisation-damping arrays for tracers' 
    7577      ENDIF 
    7678 
     
    8284      ! ------------------------------------------------------------ 
    8385 
    84       zdm0   = 0.e0 
    85       zrro = 1.e0 
    86       DO jk = jpkb,jpkm1 
    87          DO jj =1, jpj 
    88             DO ji =1, jpi 
     86      zdm0 = 0._wp 
     87      zrro = 1._wp 
     88      DO jk = jpkb, jpkm1 
     89         DO jj = 1, jpj 
     90            DO ji = 1, jpi 
    8991               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr  
    9092               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 
    91                IF( zfluo.GT.1. )   zfluo = 1.e0 
     93               IF( zfluo.GT.1. )   zfluo = 1._wp 
    9294               zdm0(ji,jj,jk) = zfluo - zfluu 
    93                IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0.e0 
     95               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
    9496               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
    9597            END DO 
    9698         END DO 
    9799      END DO 
    98  
     100      ! 
    99101      zdm0(:,:,jpk) = zrro(:,:) 
    100102 
     
    103105      ! contains total fraction, which has passed to the upper layers) 
    104106      ! ---------------------------------------------------------------------- 
    105       dminl = 0. 
    106       dmin3 = zdm0 
     107      dminl(:,:)   = 0._wp 
     108      dmin3(:,:,:) = zdm0 
    107109      DO jk = 1, jpk 
    108110         DO jj = 1, jpj 
    109111            DO ji = 1, jpi 
    110                IF( tmask(ji,jj,jk) == 0. ) THEN 
     112               IF( tmask(ji,jj,jk) == 0._wp ) THEN 
    111113                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
    112                   dmin3(ji,jj,jk) = 0.e0 
     114                  dmin3(ji,jj,jk) = 0._wp 
    113115               ENDIF 
    114116            END DO 
     
    118120      DO jj = 1, jpj 
    119121         DO ji = 1, jpi 
    120             IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0.e0 
     122            IF( tmask(ji,jj,1) == 0 )   dmin3(ji,jj,1) = 0._wp 
    121123         END DO 
    122124      END DO 
     
    124126      ! Coastal mask  
    125127      ! ------------    
    126       cmask(:,:) = 0.e0 
     128      cmask(:,:) = 0._wp 
    127129      DO ji = 2, jpi-1 
    128130         DO jj = 2, jpj-1 
    129             if (tmask(ji,jj,1) == 1) then 
     131            IF( tmask(ji,jj,1) == 1._wp ) THEN 
    130132               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) 
    131                IF (ztest == 0) cmask(ji,jj) = 1. 
    132             endif 
     133               IF( ztest == 0 )   cmask(ji,jj) = 1._wp 
     134            ENDIF 
    133135         END DO 
    134136      END DO 
     
    138140      ! Coastal surface 
    139141      ! --------------- 
    140       areacot = glob_sum( e1t(:,:) * e2t(:,:) * cmask(:,:) ) 
     142      areacot = glob_sum( e1e2t(:,:) * cmask(:,:) ) 
    141143 
    142144      ! Initialization of tracer concentration in case of  no restart  
     
    220222         trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30) 
    221223 
    222 # elif defined key_gyre 
     224 
     225# elif defined key_gyre || defined key_orca_r2 
    223226         ! LOBSTER initialisation for GYRE 
    224227         ! ---------------------- 
     
    245248 
    246249      !  initialize the POC in sediments 
    247       sedpocb(:,:) = 0.e0 
    248       sedpocn(:,:) = 0.e0 
    249       sedpoca(:,:) = 0.e0 
    250  
    251  
     250      sedpocb(:,:) = 0._wp 
     251      sedpocn(:,:) = 0._wp 
     252      sedpoca(:,:) = 0._wp 
     253      ! 
    252254      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 
    253       IF(lwp) WRITE(numout,*) ' ' 
    254  
    255  
     255      ! 
     256      IF(  wrk_not_released(2, 1)  .OR.   & 
     257           wrk_not_released(3, 1)   )   CALL ctl_stop('trc_ini_lobster: failed to release workspace arrays') 
     258      ! 
    256259   END SUBROUTINE trc_ini_lobster 
    257  
    258    SUBROUTINE trc_ctl_lobster 
    259       !!---------------------------------------------------------------------- 
    260       !!                     ***  ROUTINE trc_ctl_lobster  *** 
    261       !! 
    262       !! ** Purpose :   control the cpp options, namelist and files  
    263       !!---------------------------------------------------------------------- 
    264       INTEGER :: jl, jn 
    265  
    266       IF(lwp) WRITE(numout,*) 
    267       IF(lwp) WRITE(numout,*) ' use LOBSTER biological model ' 
    268  
    269       ! Check number of tracers 
    270       ! ----------------------- 
    271       IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' ) 
    272  
    273       ! Check tracer names 
    274       ! ------------------ 
    275       IF(   ctrcnm(jp_lob_det) /= 'DET' .OR. ctrcnm(jp_lob_zoo) /= 'ZOO' .OR.   & 
    276          &  ctrcnm(jp_lob_phy) /= 'PHY' .OR. ctrcnm(jp_lob_no3) /= 'NO3' .OR.   & 
    277          &  ctrcnm(jp_lob_nh4) /= 'NH4' .OR. ctrcnm(jp_lob_dom) /= 'DOM' .OR.   & 
    278          &  ctrcnl(jp_lob_det) /= 'Detritus'                        .OR.   & 
    279          &  ctrcnl(jp_lob_zoo) /= 'Zooplankton concentration'       .OR.   & 
    280          &  ctrcnl(jp_lob_phy) /= 'Phytoplankton concentration'     .OR.   & 
    281          &  ctrcnl(jp_lob_no3) /= 'Nitrate concentration'           .OR.   & 
    282          &  ctrcnl(jp_lob_nh4) /= 'Ammonium concentration'          .OR.   & 
    283          &  ctrcnl(jp_lob_dom) /= 'Dissolved organic matter' ) THEN 
    284          ctrcnm(jp_lob_det)='DET' 
    285          ctrcnl(jp_lob_det)='Detritus' 
    286          ctrcnm(jp_lob_zoo)='ZOO' 
    287          ctrcnl(jp_lob_zoo)='Zooplankton concentration' 
    288          ctrcnm(jp_lob_phy)='PHY' 
    289          ctrcnl(jp_lob_phy)='Phytoplankton concentration' 
    290          ctrcnm(jp_lob_no3)='NO3' 
    291          ctrcnl(jp_lob_no3)='Nitrate concentration' 
    292          ctrcnm(jp_lob_nh4)='NH4' 
    293          ctrcnl(jp_lob_nh4)='Ammonium concentration' 
    294          ctrcnm(jp_lob_dom)='DOM' 
    295          ctrcnl(jp_lob_dom)='Dissolved organic matter' 
    296          IF(lwp) THEN 
    297             CALL ctl_warn( ' We force tracer names ' ) 
    298             DO jl = 1, jp_lobster 
    299                jn = jp_lob0 + jl - 1 
    300                WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 
    301             END DO 
    302             WRITE(numout,*) ' ' 
    303          ENDIF 
    304       ENDIF 
    305  
    306       ! Check tracer units 
    307       DO jl = 1, jp_lobster 
    308          jn = jp_lob0 + jl - 1 
    309          IF( ctrcun(jn) /= 'mmole-N/m3') THEN 
    310             ctrcun(jn) = 'mmole-N/m3' 
    311             IF(lwp) THEN 
    312                CALL ctl_warn( ' We force tracer units ' ) 
    313                WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
    314             ENDIF 
    315          ENDIF 
    316       END DO 
    317  
    318    END SUBROUTINE trc_ctl_lobster 
    319260 
    320261#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90

    r2567 r2715  
    1010   !!   'key_lobster'   :                                 LOBSTER bio-model 
    1111   !!---------------------------------------------------------------------- 
    12    !! trc_nam_lobster      : LOBSTER model namelist read 
    13    !!---------------------------------------------------------------------- 
    14    USE oce_trc         ! Ocean variables 
    15    USE par_trc         ! TOP parameters 
    16    USE trc             ! TOP variables 
    17    USE sms_lobster     ! sms trends 
    18    USE in_out_manager  ! I/O manager 
     12   !! trc_nam_lobster   : LOBSTER model namelist read 
     13   !!---------------------------------------------------------------------- 
     14   USE oce_trc          ! Ocean variables 
     15   USE par_trc          ! TOP parameters 
     16   USE trc              ! TOP variables 
     17   USE sms_lobster      ! sms trends 
    1918 
    2019   IMPLICIT NONE 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r2528 r2715  
    5252      !!                xze    ??? 
    5353      !!--------------------------------------------------------------------- 
     54      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     55      USE wrk_nemo, ONLY: zpar100 => wrk_2d_1, & ! irradiance at euphotic layer depth 
     56                          zpar0m  => wrk_2d_2    ! irradiance just below the surface 
     57      USE wrk_nemo, ONLY: zparr => wrk_3d_2, &   ! red and green compound of par 
     58                          zparg => wrk_3d_3 
     59      !! 
    5460      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
    5561      !! 
     
    5965      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green 
    6066      REAL(wp) ::   zcoef               ! temporary scalar 
    61       REAL(wp), DIMENSION(jpi,jpj)     ::   zpar100         ! irradiance at euphotic layer depth 
    62       REAL(wp), DIMENSION(jpi,jpj)     ::   zpar0m          ! irradiance just below the surface 
    63       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zparr, zparg    ! red and green compound of par 
    6467 
    6568      !!--------------------------------------------------------------------- 
     69 
     70      IF( ( wrk_in_use(2, 1,2)) .OR. ( wrk_in_use(3, 2,3)) )THEN 
     71         CALL ctl_stop('trc_opt : requested workspace arrays unavailable')   ;   RETURN 
     72      END IF 
    6673 
    6774      IF( kt == nit000 ) THEN 
     
    130137      ENDIF 
    131138      ! 
     139      IF( wrk_not_released(2, 1,2)  .OR.  wrk_not_released(3, 2,3)  )   & 
     140          CALL ctl_stop('trc_opt : failed to release workspace arrays') 
     141      ! 
    132142   END SUBROUTINE trc_opt 
    133143 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcrst_lobster.F90

    r2528 r2715  
    1818   USE trcsms_lobster          ! lobster sms trends 
    1919   USE sms_lobster          ! lobster sms trends 
    20    USE in_out_manager  ! I/O manager 
    2120   USE iom 
    2221 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r2528 r2715  
    5656      !!              trend of passive tracers is saved for futher diagnostics. 
    5757      !!--------------------------------------------------------------------- 
     58      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     59      USE wrk_nemo, ONLY: zwork => wrk_3d_2 
     60      USE wrk_nemo, ONLY: zw2d  => wrk_2d_1 ! only used (if defined  
     61                                            ! key_diatrc && defined key_iomput) 
     62      !! 
    5863      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    5964      !! 
    6065      INTEGER  ::   ji, jj, jk, jl 
    6166      REAL(wp) ::   ztra 
    62       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork 
    63 #if defined key_diatrc && defined key_iomput 
    64       REAL(wp), DIMENSION(jpi,jpj) ::  zw2d 
    65 #endif 
    6667      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
    6768      CHARACTER (len=25) :: charout 
    6869      !!--------------------------------------------------------------------- 
     70 
     71      IF( ( wrk_in_use(3,2)) .OR. ( wrk_in_use(2,1)) ) THEN 
     72         CALL ctl_stop('trc_sed : requested workspace arrays unavailable.') 
     73         RETURN 
     74      END IF 
    6975 
    7076      IF( kt == nit000 ) THEN 
     
    144150      ENDIF 
    145151 
     152      IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(2, 1) ) )  & 
     153       &         CALL ctl_stop('trc_sed : failed to release workspace arrays.') 
     154 
    146155   END SUBROUTINE trc_sed 
    147156 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90

    r2528 r2715  
    1313   !!   trcsms_lobster        :  Time loop of passive tracers sms 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         ! 
     15   USE oce_trc          ! 
    1616   USE trc 
    1717   USE trcbio 
     
    3232   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3333   !! $Id$  
    34    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3535   !!---------------------------------------------------------------------- 
    36  
    3736CONTAINS 
    3837 
     
    4544      !! 
    4645      !! ** Method  : - ??? 
    47       !! ------------------------------------------------------------------------------------- 
     46      !! -------------------------------------------------------------------- 
     47      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     48      USE wrk_nemo, ONLY: ztrlob => wrk_3d_1   ! used for lobster sms trends 
     49      !! 
    4850      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    4951      INTEGER :: jn 
    50       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrlob   ! used for lobster sms trends 
    51       !! 
     52      !! -------------------------------------------------------------------- 
     53 
     54      IF( wrk_in_use(3, 1) ) THEN 
     55         CALL ctl_stop('trc_sms_lobster : requested workspace array unavailable')   ;   RETURN 
     56      ENDIF 
    5257 
    5358      CALL trc_opt( kt )      ! optical model 
     
    6570      IF( lk_trdmld_trc )  CALL trd_mld_bio( kt )   ! trends: Mixed-layer 
    6671 
     72      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_lobster : failed to release workspace array.') 
     73      ! 
    6774   END SUBROUTINE trc_sms_lobster 
    6875 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r2528 r2715  
    2424   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2525   !! $Id$  
    26    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2727   !!---------------------------------------------------------------------- 
    28  
    2928CONTAINS 
    3029 
     
    3837      !!---------------------------------------------------------------------- 
    3938 
    40       !  Control consitency 
    41       CALL trc_ctl_my_trc 
     39      !                       ! Allocate MY_TRC arrays 
     40      IF( sms_lobster_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' ) 
     41 
     42      CALL trc_ctl_my_trc     ! Control consitency 
    4243 
    4344      IF(lwp) WRITE(numout,*) 
     
    4647       
    4748      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0. 
    48  
    4949      ! 
    5050   END SUBROUTINE trc_ini_my_trc 
    51     
     51 
     52 
    5253   SUBROUTINE trc_ctl_my_trc 
    5354      !!---------------------------------------------------------------------- 
     
    5657      !! ** Purpose :   control the cpp options, namelist and files  
    5758      !!---------------------------------------------------------------------- 
    58  
    5959      INTEGER :: jl, jn 
    60  
     60      !!---------------------------------------------------------------------- 
     61      ! 
    6162      IF(lwp) WRITE(numout,*) 
    6263      IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 
    63  
     64      ! 
    6465      DO jl = 1, jp_my_trc 
    6566         jn = jp_myt0 + jl - 1 
    66          WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn 
     67         WRITE( ctrcnm(jn),'(a,i2.2)' ) 'CLR', jn 
    6768         ctrcnl(jn)='Color concentration' 
    6869         ctrcun(jn)='N/A' 
    6970      END DO 
    70  
    71  
     71      ! 
    7272   END SUBROUTINE trc_ctl_my_trc 
    7373 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r2528 r2715  
    1010   !!   'key_my_trc'                                               CFC tracers 
    1111   !!---------------------------------------------------------------------- 
    12    !! trc_sms_my_trc   : MY_TRC model main routine  
     12   !! trc_sms_my_trc       : MY_TRC model main routine  
     13   !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms 
    1314   !!---------------------------------------------------------------------- 
    1415   USE par_trc         ! TOP parameters 
     
    2122   PRIVATE 
    2223 
    23    PUBLIC   trc_sms_my_trc   ! called by trcsms.F90 module 
     24   PUBLIC   trc_sms_my_trc       ! called by trcsms.F90 module 
     25   PUBLIC   trc_sms_my_trc_alloc ! called by trcini_my_trc.F90 module 
    2426 
     27   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc 
     28    
    2529   !!---------------------------------------------------------------------- 
    2630   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    2731   !! $Id$  
    28    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2933   !!---------------------------------------------------------------------- 
    30  
    3134CONTAINS 
    3235 
     
    3942      !! ** Method  : -  
    4043      !!---------------------------------------------------------------------- 
    41       INTEGER, INTENT(in) :: kt   ! ocean time-step index 
    42       REAL(wp), DIMENSION(jpi,jpj,jpk)    ::   ztrmyt  
    43       INTEGER :: jn 
    44  
     44      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     45      USE wrk_nemo, ONLY:   ztrmyt => wrk_3d_1   ! used for lobster sms trends 
     46      ! 
     47      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     48      INTEGER ::   jn   ! dummy loop index 
     49      !!---------------------------------------------------------------------- 
    4550 
    4651      IF(lwp) WRITE(numout,*) 
     
    4954 
    5055      WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) ) 
    51         trn(:,:,1,jpmyt1) = 1. 
    52         trb(:,:,1,jpmyt1) = 1. 
    53         tra(:,:,1,jpmyt1) = 0. 
     56        trn(:,:,1,jpmyt1) = 1._wp 
     57        trb(:,:,1,jpmyt1) = 1._wp 
     58        tra(:,:,1,jpmyt1) = 0._wp 
    5459      END WHERE 
    5560 
    5661      WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80))  
    57         trn(:,:,1,jpmyt2) = 1. 
    58         trb(:,:,1,jpmyt2) = 1. 
    59         tra(:,:,1,jpmyt2) = 0. 
     62        trn(:,:,1,jpmyt2) = 1._wp 
     63        trb(:,:,1,jpmyt2) = 1._wp 
     64        tra(:,:,1,jpmyt2) = 0._wp 
    6065      END WHERE 
    6166 
    62       ! Save the trends in the ixed layer 
    63       IF( l_trdtrc ) THEN 
     67      IF( l_trdtrc ) THEN      ! Save the trends in the ixed layer 
    6468          DO jn = jp_myt0, jp_myt1 
    6569            ztrmyt(:,:,:) = tra(:,:,:,jn) 
     
    6973      ! 
    7074   END SUBROUTINE trc_sms_my_trc 
    71     
     75 
     76 
     77   INTEGER FUNCTION trc_sms_my_trc_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      !!              ***  ROUTINE trc_sms_my_trc_alloc  *** 
     80      !!---------------------------------------------------------------------- 
     81      ! 
     82      ! ALLOCATE here the arrays specific to MY_TRC 
     83      ! ALLOCATE( tab(...) , STAT=trc_sms_my_trc_alloc ) 
     84      trc_sms_my_trc_alloc = 0      ! set to zero if no array to be allocated 
     85      ! 
     86      IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_warn('trc_sms_my_trc_alloc : failed to allocate arrays') 
     87      ! 
     88   END FUNCTION trc_sms_my_trc_alloc 
     89 
     90 
    7291#else 
    7392   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r2528 r2715  
    3232 
    3333   PUBLIC  p4z_bio     
    34  
    35    !! * Shared module variables 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    37       xnegtr            ! Array used to indicate negative tracer values 
    38  
    3934 
    4035   !!* Substitution 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r2528 r2715  
    44   !! TOP :   PISCES Sea water chemistry computed following OCMIP protocol 
    55   !!====================================================================== 
    6    !! History :    -   !  1988     (E. Maier-Reimer)  Original code 
     6   !! History :   OPA  !  1988     (E. Maier-Reimer)  Original code 
    77   !!              -   !  1998     (O. Aumont)  addition 
    88   !!              -   !  1999     (C. Le Quere)  modification 
    9    !!             1.0  !  2004     (O. Aumont)  modification 
     9   !!   NEMO      1.0  !  2004     (O. Aumont)  modification 
    1010   !!              -   !  2006     (R. Gangsto)  modification 
    1111   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     
    1515   !!   'key_pisces'                                       PISCES bio-model 
    1616   !!---------------------------------------------------------------------- 
    17    !!   p4z_che        :  Sea water chemistry computed following OCMIP protocol 
    18    !!---------------------------------------------------------------------- 
    19    USE oce_trc         ! 
    20    USE trc         ! 
    21    USE sms_pisces      !  
     17   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol 
     18   !!---------------------------------------------------------------------- 
     19   USE oce_trc       ! 
     20   USE trc           ! 
     21   USE sms_pisces    !  
     22   USE lib_mpp       ! MPP library 
    2223 
    2324   IMPLICIT NONE 
    2425   PRIVATE 
    2526 
    26    PUBLIC   p4z_che   
    27  
    28    !! * Shared module variables 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    30       sio3eq, fekeq           !: chemistry of Fe and Si 
    31  
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2)   ::   &   !: 
    33       chemc                   !: Solubilities of O2 and CO2 
    34  
    35    !! * Module variables 
    36  
    37    REAL(wp) :: & 
    38       salchl = 1./1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    39  
    40    REAL(wp) :: &            ! coeff. for apparent solubility equilibrium  
    41       akcc1 = -171.9065 , &    ! Millero et al. 1995 from Mucci 1983 
    42       akcc2 = -0.077993 , &   
    43       akcc3 = 2839.319  , &   
    44       akcc4 = 71.595    , &   
    45       akcc5 = -0.77712  , &   
    46       akcc6 = 0.0028426 , &   
    47       akcc7 = 178.34    , &   
    48       akcc8 = -0.07711  , &   
    49       akcc9 = 0.0041249 
    50  
    51    REAL(wp) :: &             ! universal gas constants 
    52       rgas = 83.143, & 
    53       oxyco = 1./22.4144 
    54  
    55    REAL(wp) :: &             ! borat constants 
    56       bor1 = 0.00023, & 
    57       bor2 = 1./10.82 
    58  
    59    REAL(wp) :: &              ! 
    60       ca0 = -162.8301  , & 
    61       ca1 = 218.2968   , & 
    62       ca2 = 90.9241    , & 
    63       ca3 = -1.47696   , & 
    64       ca4 = 0.025695   , & 
    65       ca5 = -0.025225  , & 
    66       ca6 = 0.0049867 
    67  
    68    REAL(wp) :: &              ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
    69       c10 = -3670.7   , & 
    70       c11 = 62.008    , & 
    71       c12 = -9.7944   , & 
    72       c13 = 0.0118    , & 
    73       c14 = -0.000116 
     27   PUBLIC   p4z_che         ! 
     28   PUBLIC   p4z_che_alloc   ! 
     29 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sio3eq   ! chemistry of Si 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fekeq    ! chemistry of Fe 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2 
     33 
     34   REAL(wp) ::   salchl = 1._wp / 1.80655_wp ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
     35 
     36   REAL(wp) ::   akcc1 = -171.9065_wp      ! coeff. for apparent solubility equilibrium 
     37   REAL(wp) ::   akcc2 =   -0.077993_wp    ! Millero et al. 1995 from Mucci 1983 
     38   REAL(wp) ::   akcc3 = 2839.319_wp       ! 
     39   REAL(wp) ::   akcc4 =   71.595_wp       ! 
     40   REAL(wp) ::   akcc5 =   -0.77712_wp     ! 
     41   REAL(wp) ::   akcc6 =    0.0028426_wp   ! 
     42   REAL(wp) ::   akcc7 =  178.34_wp        ! 
     43   REAL(wp) ::   akcc8 =   -0.07711_wp     ! 
     44   REAL(wp) ::   akcc9 =    0.0041249_wp   ! 
     45 
     46   REAL(wp) ::   rgas  = 83.143_wp         ! universal gas constants 
     47   REAL(wp) ::   oxyco = 1._wp / 22.4144_wp 
     48 
     49   REAL(wp) ::   bor1 = 0.00023_wp         ! borat constants 
     50   REAL(wp) ::   bor2 = 1._wp / 10.82_wp 
     51 
     52   REAL(wp) ::   ca0 = -162.8301_wp 
     53   REAL(wp) ::   ca1 =  218.2968_wp 
     54   REAL(wp) ::   ca2 =   90.9241_wp 
     55   REAL(wp) ::   ca3 =   -1.47696_wp 
     56   REAL(wp) ::   ca4 =    0.025695_wp 
     57   REAL(wp) ::   ca5 =   -0.025225_wp 
     58   REAL(wp) ::   ca6 =    0.0049867_wp 
     59 
     60   REAL(wp) ::   c10 = -3670.7_wp        ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
     61   REAL(wp) ::   c11 =    62.008_wp      
     62   REAL(wp) ::   c12 =    -9.7944_wp     
     63   REAL(wp) ::   c13 =     0.0118_wp      
     64   REAL(wp) ::   c14 =    -0.000116_wp 
    7465 
    7566   REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
     
    133124      ox2 = 23.8439    , & 
    134125      ox3 = -0.034892  , & 
    135       ox4 = 0.015568   , & 
     126      ox4 =  0.015568  , & 
    136127      ox5 = -0.0019387  
    137128 
     
    151142   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    152143   !! $Id$  
    153    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    154    !!---------------------------------------------------------------------- 
    155  
     144   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     145   !!---------------------------------------------------------------------- 
    156146CONTAINS 
    157147 
     
    179169!CDIR NOVERRCHK 
    180170         DO ji = 1, jpi 
    181  
    182171            !                             ! SET ABSOLUTE TEMPERATURE 
    183172            ztkel = tsn(ji,jj,1,jp_tem) + 273.16 
     
    324313   END SUBROUTINE p4z_che 
    325314 
     315 
     316   INTEGER FUNCTION p4z_che_alloc() 
     317      !!---------------------------------------------------------------------- 
     318      !!                     ***  ROUTINE p4z_che_alloc  *** 
     319      !!---------------------------------------------------------------------- 
     320      ALLOCATE( sio3eq(jpi,jpj,jpk) , fekeq(jpi,jpj,jpk) , chemc (jpi,jpj,2), STAT=p4z_che_alloc ) 
     321      ! 
     322      IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 
     323      ! 
     324   END FUNCTION p4z_che_alloc 
     325 
    326326#else 
    327327   !!====================================================================== 
     
    330330CONTAINS 
    331331   SUBROUTINE p4z_che( kt )                   ! Empty routine 
    332       INTEGER, INTENT( in ) ::   kt 
     332      INTEGER, INTENT(in) ::   kt 
    333333      WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 
    334334   END SUBROUTINE p4z_che 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r2528 r2715  
    2727   USE sbc_oce , ONLY :  atm_co2 
    2828#endif 
    29    USE lib_mpp 
    30    USE lib_fortran 
    3129 
    3230   IMPLICIT NONE 
     
    3533   PUBLIC   p4z_flx   
    3634   PUBLIC   p4z_flx_init   
    37  
    38    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  oce_co2            !: ocean carbon flux  
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::  satmco2            !: atmospheric pco2 
    40    REAL(wp)                             ::  t_oce_co2_flx      !: Total ocean carbon flux  
    41    REAL(wp)                             ::  t_atm_co2_flx      !: global mean of atmospheric pco2 
    42    REAL(wp)                             ::  area               !: ocean surface 
    43    REAL(wp)                             ::  atcco2 = 278.      !: pre-industrial atmospheric [co2] (ppm)     
    44    REAL(wp)                             ::  atcox  = 0.20946   !: 
    45    REAL(wp)                             ::  xconv  = 0.01/3600 !: coefficients for conversion  
     35   PUBLIC   p4z_flx_alloc   
     36 
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux  
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
     39 
     40   REAL(wp) ::  t_oce_co2_flx               !: Total ocean carbon flux  
     41   REAL(wp) ::  t_atm_co2_flx               !: global mean of atmospheric pco2 
     42   REAL(wp) ::  area                        !: ocean surface 
     43   REAL(wp) ::  atcco2 = 278._wp            !: pre-industrial atmospheric [co2] (ppm)   
     44   REAL(wp) ::  atcox  = 0.20946_wp         !: 
     45   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    4646 
    4747   !!* Substitution 
     
    5050   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5151   !! $Id$  
    52    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    53    !!---------------------------------------------------------------------- 
    54  
     52   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     53   !!---------------------------------------------------------------------- 
    5554CONTAINS 
    5655 
     
    6362      !! ** Method  : - ??? 
    6463      !!--------------------------------------------------------------------- 
    65       INTEGER, INTENT(in) :: kt 
     64      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     65      USE wrk_nemo, ONLY:   zkgco2 => wrk_2d_1 , zkgo2 => wrk_2d_2 , zh2co3 => wrk_2d_3  
     66      USE wrk_nemo, ONLY:   zoflx  => wrk_2d_4 , zkg   => wrk_2d_5 
     67      USE wrk_nemo, ONLY:   zdpco2 => wrk_2d_6 , zdpo2 => wrk_2d_7 
     68      ! 
     69      INTEGER, INTENT(in) ::   kt   ! 
     70      ! 
    6671      INTEGER  ::   ji, jj, jrorr 
    6772      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan 
    6873      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    6974      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
    70       REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3 
    71 #if defined key_diatrc && defined key_iomput 
    72       REAL(wp), DIMENSION(jpi,jpj) ::  zoflx, zkg, zdpco2, zdpo2 
    73 #endif 
    7475      CHARACTER (len=25) :: charout 
    75  
    7676      !!--------------------------------------------------------------------- 
     77 
     78      IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 
     79         CALL ctl_stop('p4z_flx: requested workspace arrays unavailable')   ;   RETURN 
     80      ENDIF 
    7781 
    7882      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
     
    149153            zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    150154            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
    151             oce_co2(ji,jj) = ( zfld - zflu ) * rfact & 
    152                &             * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
     155            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    153156            ! compute the trend 
    154157            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
     
    162165            ! Save diagnostics 
    163166#  if ! defined key_iomput 
    164             zfact = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) / rfact 
     167            zfact = 1. / e1e2t(ji,jj) / rfact 
    165168            trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact 
    166169            trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
     
    180183      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon 
    181184      IF( kt == nitend ) THEN 
    182          t_atm_co2_flx = glob_sum( satmco2(:,:) * e1t(:,:) * e2t(:,:) )            ! Total atmospheric pCO2 
     185         t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2 
    183186         ! 
    184187         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15                      ! Conversion in PgC ; negative for out of the ocean 
     
    203206 
    204207# if defined key_diatrc && defined key_iomput 
    205       CALL iom_put( "Cflx" , oce_co2(:,:) / ( e1t(:,:) * e2t(:,:) ) / rfact  ) 
     208      CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact )  
    206209      CALL iom_put( "Oflx" , zoflx  ) 
    207210      CALL iom_put( "Kg"   , zkg    ) 
     
    209212      CALL iom_put( "Dpo2" , zdpo2  ) 
    210213#endif 
    211  
     214      ! 
     215      IF( wrk_not_released(2, 1,2,3,4,5,6,7) )   CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
     216      ! 
    212217   END SUBROUTINE p4z_flx 
    213218 
     219 
    214220   SUBROUTINE p4z_flx_init 
    215  
    216221      !!---------------------------------------------------------------------- 
    217222      !!                  ***  ROUTINE p4z_flx_init  *** 
     
    222227      !!      called at the first timestep (nit000) 
    223228      !! ** input   :   Namelist nampisext 
    224       !! 
    225       !!---------------------------------------------------------------------- 
    226  
     229      !!---------------------------------------------------------------------- 
    227230      NAMELIST/nampisext/ atcco2 
    228  
     231      !!---------------------------------------------------------------------- 
     232      ! 
    229233      REWIND( numnat )                     ! read numnat 
    230234      READ  ( numnat, nampisext ) 
    231  
     235      ! 
    232236      IF(lwp) THEN                         ! control print 
    233237         WRITE(numout,*) ' ' 
     
    236240         WRITE(numout,*) '    Atmospheric pCO2      atcco2      =', atcco2 
    237241      ENDIF 
    238  
    239       ! interior global domain surface 
    240       area = glob_sum( e1t(:,:) * e2t(:,:) )   
    241  
    242       ! Initialization of Flux of Carbon 
    243       oce_co2(:,:)  = 0._wp 
     242      ! 
     243      area = glob_sum( e1e2t(:,:) )        ! interior global domain surface 
     244      ! 
     245      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
    244246      t_atm_co2_flx = 0._wp 
    245       ! Initialisation of atmospheric pco2 
    246       satmco2(:,:)  = atcco2 
     247      ! 
     248      satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    247249      t_oce_co2_flx = 0._wp 
    248  
     250      ! 
    249251   END SUBROUTINE p4z_flx_init 
     252 
     253 
     254   INTEGER FUNCTION p4z_flx_alloc() 
     255      !!---------------------------------------------------------------------- 
     256      !!                     ***  ROUTINE p4z_flx_alloc  *** 
     257      !!---------------------------------------------------------------------- 
     258      ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 
     259      ! 
     260      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
     261      ! 
     262   END FUNCTION p4z_flx_alloc 
    250263 
    251264#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    r2528 r2715  
    2121 
    2222   PUBLIC   p4z_int   
     23   PUBLIC   p4z_int_alloc 
    2324 
    24    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    25       tgfunc,            &  !:  Temp. dependancy of various biological rates 
    26       tgfunc2               !:  Temp. dependancy of mesozooplankton rates  
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates 
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    2727 
    28    !! * Module variables 
    29    REAL(wp) :: & 
    30       xksilim = 16.5E-6        ! Half-saturation constant for the computation of the Si half-saturation constant 
    31  
     28   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation 
    3229 
    3330   !!---------------------------------------------------------------------- 
    3431   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3532   !! $Id$  
    36    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3734   !!---------------------------------------------------------------------- 
    38  
    3935CONTAINS 
    4036 
     
    4743      !! ** Method  : - ??? 
    4844      !!--------------------------------------------------------------------- 
    49       !! 
    5045      INTEGER  ::   ji, jj 
    5146      REAL(wp) ::   zdum 
     
    5449      ! Computation of phyto and zoo metabolic rate 
    5550      ! ------------------------------------------- 
    56  
    5751      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
    5852      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
     
    6155      ! constant for silica uptake 
    6256      ! --------------------------------------------------- 
    63  
    6457      DO ji = 1, jpi 
    6558         DO jj = 1, jpj 
     
    6861         END DO 
    6962      END DO 
    70  
     63      ! 
    7164      IF( nday_year == nyear_len(1) ) THEN 
    7265         xksi    = xksimax 
    73          xksimax = 0.e0 
     66         xksimax = 0._wp 
    7467      ENDIF 
    7568      ! 
    7669   END SUBROUTINE p4z_int 
     70 
     71 
     72   INTEGER FUNCTION p4z_int_alloc() 
     73      !!---------------------------------------------------------------------- 
     74      !!                     ***  ROUTINE p4z_int_alloc  *** 
     75      !!---------------------------------------------------------------------- 
     76      ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 
     77      ! 
     78      IF( p4z_int_alloc /= 0 )   CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
     79      ! 
     80   END FUNCTION p4z_int_alloc 
    7781 
    7882#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r2528 r2715  
    3131 
    3232   !! * Shared module variables 
    33    REAL(wp), PUBLIC ::   & 
    34      kdca = 0.327e3_wp   ,  &  !: 
    35      nca  = 1.0_wp             !: 
     33   REAL(wp), PUBLIC :: kdca = 0.327e3_wp  !: diss. rate constant calcite 
     34   REAL(wp), PUBLIC :: nca  = 1.0_wp      !: order of reaction for calcite dissolution 
    3635 
    3736   !! * Module variables 
    38    REAL(wp) :: & 
    39       calcon = 1.03E-2        ! mean calcite concentration [Ca2+] in sea water [mole/kg solution] 
    40  
    41    INTEGER ::               & 
    42      rmtss                    !: number of seconds per month 
     37   REAL(wp) :: calcon = 1.03E-2           !: mean calcite concentration [Ca2+] in sea water [mole/kg solution] 
     38  
     39   INTEGER  :: rmtss                      !: number of seconds per month  
    4340 
    4441   !!---------------------------------------------------------------------- 
     
    6057      !! ** Method  : - ??? 
    6158      !!--------------------------------------------------------------------- 
     59      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     60      USE wrk_nemo, ONLY: zco3 => wrk_3d_2, zcaldiss => wrk_3d_3  
     61      ! 
    6262      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6363      INTEGER  ::   ji, jj, jk, jn 
     
    6565      REAL(wp) ::   zdispot, zfact, zalka 
    6666      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    67       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3 
    6867#if defined key_diatrc && defined key_iomput 
    6968      REAL(wp) ::   zrfact2 
    70       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss 
    7169#endif 
    7270      CHARACTER (len=25) :: charout 
    7371      !!--------------------------------------------------------------------- 
    7472 
     73      IF(  wrk_in_use(3, 2,3) ) THEN 
     74         CALL ctl_stop('p4z_lys: requested workspace arrays unavailable')  ;  RETURN 
     75      END IF 
     76 
    7577      zco3(:,:,:) = 0. 
    76  
    7778# if defined key_diatrc && defined key_iomput 
    7879      zcaldiss(:,:,:) = 0. 
     
    186187       ENDIF 
    187188 
     189      IF( wrk_not_released(3, 2,3) ) CALL ctl_stop('p4z_lys: failed to release workspace arrays') 
     190      ! 
    188191   END SUBROUTINE p4z_lys 
    189192 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2528 r2715  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    8    !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisaion 
     8   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation 
    99   !!---------------------------------------------------------------------- 
    1010#if defined  key_pisces 
     
    2424   PUBLIC   p4z_opt        ! called in p4zbio.F90 module 
    2525   PUBLIC   p4z_opt_init   ! called in trcsms_pisces.F90 module 
    26  
    27    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   etot, enano, ediat   !: PAR for phyto, nano and diat  
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   emoy                 !: averaged PAR in the mixed layer 
    29  
    30    INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    31    REAL(wp) ::  parlux = 0.43 / 3.e0 
    32  
    33    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption 
     26   PUBLIC   p4z_opt_alloc 
     27 
     28   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot, enano, ediat   !: PAR for phyto, nano and diat  
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy                 !: averaged PAR in the mixed layer 
     30 
     31   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     32   REAL(wp) ::   parlux = 0.43_wp / 3._wp 
     33 
     34   REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    3435    
    3536   !!* Substitution 
     
    3839   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3940   !! $Id$  
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    41    !!---------------------------------------------------------------------- 
    42  
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     42   !!---------------------------------------------------------------------- 
    4343CONTAINS 
    4444 
     
    5252      !! ** Method  : - ??? 
    5353      !!--------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
     54      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     55      USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 
     56      USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr  => wrk_3d_3 , zekb => wrk_3d_4 
     57      USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1   => wrk_3d_6 
     58      USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3   => wrk_3d_8 
     59      ! 
     60      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
     61      ! 
    5562      INTEGER  ::   ji, jj, jk 
    5663      INTEGER  ::   irgb 
    5764      REAL(wp) ::   zchl, zxsi0r 
    5865      REAL(wp) ::   zc0 , zc1 , zc2, zc3 
    59       REAL(wp), DIMENSION(jpi,jpj)     ::   zdepmoy, zetmp 
    60       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb 
    61       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3, ze0 
    6266      !!--------------------------------------------------------------------- 
    6367 
     68      IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
     69         CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN 
     70      ENDIF 
    6471 
    6572      !     Initialisation of variables used to compute PAR 
    6673      !     ----------------------------------------------- 
    67       ze1 (:,:,jpk) = 0.e0 
    68       ze2 (:,:,jpk) = 0.e0 
    69       ze3 (:,:,jpk) = 0.e0 
     74      ze1 (:,:,jpk) = 0._wp 
     75      ze2 (:,:,jpk) = 0._wp 
     76      ze3 (:,:,jpk) = 0._wp 
    7077 
    7178      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
     
    203210!CDIR NOVERRCHK 
    204211            DO ji = 1, jpi 
    205                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) & 
    206        &           emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
     212               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) )   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
    207213            END DO 
    208214         END DO 
     
    223229#endif 
    224230      ! 
     231      IF(  wrk_not_released(2, 1,2)           .OR.   & 
     232           wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
     233      ! 
    225234   END SUBROUTINE p4z_opt 
     235 
    226236 
    227237   SUBROUTINE p4z_opt_init 
     
    230240      !! 
    231241      !! ** Purpose :   Initialization of tabulated attenuation coef 
    232       !! 
    233       !! 
    234       !!---------------------------------------------------------------------- 
    235  
     242      !!---------------------------------------------------------------------- 
     243      ! 
    236244      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
    237 !!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients 
    238245      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
     246      ! 
    239247      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    240248      ! 
    241                          etot (:,:,:) = 0.e0 
    242                          enano(:,:,:) = 0.e0 
    243                          ediat(:,:,:) = 0.e0 
    244       IF( ln_qsr_bio )   etot3(:,:,:) = 0.e0 
     249                         etot (:,:,:) = 0._wp 
     250                         enano(:,:,:) = 0._wp 
     251                         ediat(:,:,:) = 0._wp 
     252      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp 
    245253      !  
    246254   END SUBROUTINE p4z_opt_init 
     255 
     256 
     257   INTEGER FUNCTION p4z_opt_alloc() 
     258      !!---------------------------------------------------------------------- 
     259      !!                     ***  ROUTINE p4z_opt_alloc  *** 
     260      !!---------------------------------------------------------------------- 
     261      ALLOCATE( etot (jpi,jpj,jpk) , enano(jpi,jpj,jpk) ,     & 
     262         &      ediat(jpi,jpj,jpk) , emoy (jpi,jpj,jpk) , STAT=p4z_opt_alloc ) 
     263         ! 
     264      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 
     265      ! 
     266   END FUNCTION p4z_opt_alloc 
     267 
    247268#else 
    248269   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2528 r2715  
    2222   USE iom 
    2323 
    24    USE lib_mpp 
    25    USE lib_fortran 
    26  
    2724   IMPLICIT NONE 
    2825   PRIVATE 
     
    3027   PUBLIC   p4z_prod         ! called in p4zbio.F90 
    3128   PUBLIC   p4z_prod_init    ! called in trcsms_pisces.F90 
    32  
    33    !! * Shared module variables 
     29   PUBLIC   p4z_prod_alloc 
     30 
    3431   REAL(wp), PUBLIC ::   & 
    3532     pislope   = 3.0_wp          ,  &  !: 
     
    4340     grosip    = 0.151_wp 
    4441 
    45    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::  prmax  
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax   !: 
    4643    
    4744   REAL(wp) ::   & 
     
    5653   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5754   !! $Id$  
    58    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    59    !!---------------------------------------------------------------------- 
    60  
     55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     56   !!---------------------------------------------------------------------- 
    6157CONTAINS 
    6258 
     
    7066      !! ** Method  : - ??? 
    7167      !!--------------------------------------------------------------------- 
     68      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     69      USE wrk_nemo, ONLY:   zmixnano   => wrk_2d_1  , zmixdiat    => wrk_2d_2  , zstrn  => wrk_2d_3 
     70      USE wrk_nemo, ONLY:   zpislopead => wrk_3d_2  , zpislopead2 => wrk_3d_3 
     71      USE wrk_nemo, ONLY:   zprdia     => wrk_3d_4  , zprbio      => wrk_3d_5  , zysopt => wrk_3d_6 
     72      USE wrk_nemo, ONLY:   zprorca    => wrk_3d_7  , zprorcad    => wrk_3d_8 
     73      USE wrk_nemo, ONLY:   zprofed    => wrk_3d_9  , zprofen     => wrk_3d_10 
     74      USE wrk_nemo, ONLY:   zprochln   => wrk_3d_11 , zprochld    => wrk_3d_12 
     75      USE wrk_nemo, ONLY:   zpronew    => wrk_3d_13 , zpronewd    => wrk_3d_14 
     76      ! 
    7277      INTEGER, INTENT(in) :: kt, jnt 
     78      ! 
    7379      INTEGER  ::   ji, jj, jk 
    7480      REAL(wp) ::   zsilfac, zfact 
     
    8187      REAL(wp) ::   zrfact2 
    8288#endif 
    83       REAL(wp), DIMENSION(jpi,jpj)     ::   zmixnano   , zmixdiat, zstrn 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpislopead , zpislopead2 
    85       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprdia     , zprbio, zysopt 
    86       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprorca    , zprorcad, zprofed 
    87       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zprofen   , zprochln, zprochld 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zpronew    , zpronewd 
    8989      CHARACTER (len=25) :: charout 
    9090      !!--------------------------------------------------------------------- 
    9191 
    92       zprorca (:,:,:) = 0.0 
    93       zprorcad(:,:,:) = 0.0 
    94       zprofed(:,:,:) = 0.0 
    95       zprofen(:,:,:) = 0.0 
    96       zprochln(:,:,:) = 0.0 
    97       zprochld(:,:,:) = 0.0 
    98       zpronew (:,:,:) = 0.0 
    99       zpronewd(:,:,:) = 0.0 
    100       zprdia  (:,:,:) = 0.0 
    101       zprbio  (:,:,:) = 0.0 
    102       zysopt  (:,:,:) = 0.0 
     92      IF( wrk_in_use(2, 1,2,3)                             .OR.  & 
     93          wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)  ) THEN 
     94          CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')   ;   RETURN 
     95      ENDIF 
     96 
     97      zprorca (:,:,:) = 0._wp 
     98      zprorcad(:,:,:) = 0._wp 
     99      zprofed (:,:,:) = 0._wp 
     100      zprofen (:,:,:) = 0._wp 
     101      zprochln(:,:,:) = 0._wp 
     102      zprochld(:,:,:) = 0._wp 
     103      zpronew (:,:,:) = 0._wp 
     104      zpronewd(:,:,:) = 0._wp 
     105      zprdia  (:,:,:) = 0._wp 
     106      zprbio  (:,:,:) = 0._wp 
     107      zysopt  (:,:,:) = 0._wp 
    103108 
    104109      ! Computation of the optimal production 
    105  
    106110# if defined key_degrad 
    107111      prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
     
    111115 
    112116      ! compute the day length depending on latitude and the day 
    113       zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp) 
    114       zcodel = ASIN(  SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 )  ) 
     117      zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
     118      zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
    115119 
    116120      ! day length in hours 
    117       zstrn(:,:) = 0. 
     121      zstrn(:,:) = 0._wp 
    118122      DO jj = 1, jpj 
    119123         DO ji = 1, jpi 
     
    187191                  zsilfac = MIN( 6.4,zsilfac * zsilfac2) 
    188192                  zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 
    189  
    190193              ENDIF 
    191194            END DO 
     
    357360#endif 
    358361 
    359        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     362      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    360363         WRITE(charout, FMT="('prod')") 
    361364         CALL prt_ctl_trc_info(charout) 
    362365         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    363        ENDIF 
    364  
     366      ENDIF 
     367 
     368      IF(  wrk_not_released(2, 1,2,3)                          .OR.  & 
     369           wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)   )   & 
     370           CALL ctl_stop('p4z_prod: failed to release workspace arrays') 
     371      ! 
    365372   END SUBROUTINE p4z_prod 
    366373 
     374 
    367375   SUBROUTINE p4z_prod_init 
    368  
    369376      !!---------------------------------------------------------------------- 
    370377      !!                  ***  ROUTINE p4z_prod_init  *** 
     
    376383      !! 
    377384      !! ** input   :   Namelist nampisprod 
    378       !! 
    379385      !!---------------------------------------------------------------------- 
    380  
    381386      NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm,   & 
    382387         &              fecnm, fecdm, grosip 
     388      !!---------------------------------------------------------------------- 
    383389 
    384390      REWIND( numnat )                     ! read numnat 
     
    399405         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
    400406      ENDIF 
    401  
     407      ! 
    402408      rday1     = 0.6 / rday  
    403409      texcret   = 1.0 - excret 
    404410      texcret2  = 1.0 - excret2 
    405411      tpp       = 0. 
    406  
     412      ! 
    407413   END SUBROUTINE p4z_prod_init 
    408414 
    409415 
     416   INTEGER FUNCTION p4z_prod_alloc() 
     417      !!---------------------------------------------------------------------- 
     418      !!                     ***  ROUTINE p4z_prod_alloc  *** 
     419      !!---------------------------------------------------------------------- 
     420      ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 
     421      ! 
     422      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 
     423      ! 
     424   END FUNCTION p4z_prod_alloc 
    410425 
    411426#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r2528 r2715  
    2929   PUBLIC   p4z_rem         ! called in p4zbio.F90 
    3030   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90 
    31  
    32    !! * Shared module variables 
     31   PUBLIC   p4z_rem_alloc 
     32 
    3333   REAL(wp), PUBLIC ::   & 
    3434     xremik  = 0.3_wp      ,  & !: 
     
    3939     oxymin  = 1.e-6_wp         !: 
    4040 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::    & !: 
    42      &                   denitr                     !: denitrification array 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
    4342 
    4443 
     
    4847   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4948   !! $Id$  
    50    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    51    !!---------------------------------------------------------------------- 
    52  
     49   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     50   !!---------------------------------------------------------------------- 
    5351CONTAINS 
    5452 
     
    6159      !! ** Method  : - ??? 
    6260      !!--------------------------------------------------------------------- 
     61      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     62      USE wrk_nemo, ONLY:   ztempbac => wrk_2d_1 
     63      USE wrk_nemo, ONLY:   zdepbac  => wrk_3d_2 , zfesatur => wrk_3d_2 , zolimi => wrk_3d_4 
     64      ! 
    6365      INTEGER, INTENT(in) ::   kt ! ocean time step 
     66      ! 
    6467      INTEGER  ::   ji, jj, jk 
    6568      REAL(wp) ::   zremip, zremik , zlam1b 
     
    7275#endif 
    7376      REAL(wp) ::   zlamfac, zonitr, zstep 
    74       REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac 
    75       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi 
    7677      CHARACTER (len=25) :: charout 
    77  
    7878      !!--------------------------------------------------------------------- 
    7979 
     80      IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 2,3,4)  ) THEN 
     81         CALL ctl_stop('p4z_rem: requested workspace arrays unavailable')   ;   RETURN 
     82      ENDIF 
    8083 
    8184       ! Initialisation of temprary arrys 
    82        zdepbac (:,:,:) = 0.0 
    83        zfesatur(:,:,:) = 0.0 
    84        zolimi  (:,:,:) = 0.0 
    85        ztempbac(:,:)   = 0.0 
     85       zdepbac (:,:,:) = 0._wp 
     86       zfesatur(:,:,:) = 0._wp 
     87       zolimi  (:,:,:) = 0._wp 
     88       ztempbac(:,:)   = 0._wp 
    8689 
    8790      !  Computation of the mean phytoplankton concentration as 
    8891      !  a crude estimate of the bacterial biomass 
    8992      !   -------------------------------------------------- 
    90  
    9193      DO jk = 1, jpkm1 
    9294         DO jj = 1, jpj 
     
    362364               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 
    363365#endif 
    364  
    365             END DO 
    366          END DO 
    367       END DO 
    368       ! 
    369  
    370        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     366            END DO 
     367         END DO 
     368      END DO 
     369      ! 
     370 
     371      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    371372         WRITE(charout, FMT="('rem5')") 
    372373         CALL prt_ctl_trc_info(charout) 
    373374         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    374        ENDIF 
    375  
    376        !     Update the arrays TRA which contain the biological sources and sinks 
    377        !     -------------------------------------------------------------------- 
     375      ENDIF 
     376 
     377      !     Update the arrays TRA which contain the biological sources and sinks 
     378      !     -------------------------------------------------------------------- 
    378379 
    379380      DO jk = 1, jpkm1 
     
    385386         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 
    386387         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 
    387      END DO 
    388  
    389        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     388      END DO 
     389 
     390      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    390391         WRITE(charout, FMT="('rem6')") 
    391392         CALL prt_ctl_trc_info(charout) 
    392393         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    393        ENDIF 
    394  
     394      ENDIF 
     395      ! 
     396      IF(  wrk_not_released(2, 1)     .OR.   & 
     397           wrk_not_released(3, 2,3,4)  )   CALL ctl_stop('p4z_rem: failed to release workspace arrays') 
     398      ! 
    395399   END SUBROUTINE p4z_rem 
    396400 
     401 
    397402   SUBROUTINE p4z_rem_init 
    398  
    399403      !!---------------------------------------------------------------------- 
    400404      !!                  ***  ROUTINE p4z_rem_init  *** 
     
    408412      !! 
    409413      !!---------------------------------------------------------------------- 
    410  
    411414      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xlam1, oxymin 
     415      !!---------------------------------------------------------------------- 
    412416 
    413417      REWIND( numnat )                     ! read numnat 
     
    425429         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin    =', oxymin 
    426430      ENDIF 
    427  
    428       nitrfac(:,:,:) = 0.0 
    429       denitr (:,:,:) = 0. 
    430  
     431      ! 
     432      nitrfac(:,:,:) = 0._wp 
     433      denitr (:,:,:) = 0._wp 
     434      ! 
    431435   END SUBROUTINE p4z_rem_init 
     436 
     437 
     438   INTEGER FUNCTION p4z_rem_alloc() 
     439      !!---------------------------------------------------------------------- 
     440      !!                     ***  ROUTINE p4z_rem_alloc  *** 
     441      !!---------------------------------------------------------------------- 
     442      ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
     443      ! 
     444      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 
     445      ! 
     446   END FUNCTION p4z_rem_alloc 
    432447 
    433448#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r2528 r2715  
    1818   USE oce_trc         ! 
    1919   USE sms_pisces 
    20    USE lib_mpp 
    21    USE lib_fortran 
    2220   USE prtctl_trc 
    2321   USE p4zbio 
     
    2725   USE p4zrem 
    2826   USE p4zlim 
    29    USE lbclnk 
    3027   USE iom 
    3128 
     
    3633   PUBLIC   p4z_sed    
    3734   PUBLIC   p4z_sed_init    
     35   PUBLIC   p4z_sed_alloc 
    3836 
    3937   !! * Shared module variables 
    40    LOGICAL, PUBLIC ::    & 
    41      ln_dustfer  = .FALSE.      ,  &  !: 
    42      ln_river    = .FALSE.      ,  &  !: 
    43      ln_ndepo    = .FALSE.      ,  &  !: 
    44      ln_sedinput = .FALSE.            !: 
    45  
    46    REAL(wp), PUBLIC ::   & 
    47      sedfeinput = 1.E-9_wp   ,  &  !: 
    48      dustsolub  = 0.014_wp         !: 
     38   LOGICAL, PUBLIC :: ln_dustfer  = .FALSE.    !: boolean for dust input from the atmosphere 
     39   LOGICAL, PUBLIC :: ln_river    = .FALSE.    !: boolean for river input of nutrients 
     40   LOGICAL, PUBLIC :: ln_ndepo    = .FALSE.    !: boolean for atmospheric deposition of N 
     41   LOGICAL, PUBLIC :: ln_sedinput = .FALSE.    !: boolean for Fe input from sediments 
     42 
     43   REAL(wp), PUBLIC :: sedfeinput = 1.E-9_wp   !: Coastal release of Iron 
     44   REAL(wp), PUBLIC :: dustsolub  = 0.014_wp   !: Solubility of the dust 
    4945 
    5046   !! * Module variables 
    51    REAL(wp) :: ryyss               !: number of seconds per year  
    52    REAL(wp) :: ryyss1              !: inverse of ryyss 
    53    REAL(wp) :: rmtss               !: number of seconds per month 
    54    REAL(wp) :: rday1               !: inverse of rday 
    55  
    56    INTEGER , PARAMETER :: & 
    57         jpmth = 12, jpyr = 1 
    58    INTEGER ::                   & 
    59       numdust,                  &  !: logical unit for surface fluxes data 
    60       nflx1 , nflx2,            &  !: first and second record used 
    61       nflx11, nflx12      ! ??? 
    62    REAL(wp), DIMENSION(jpi,jpj,jpmth) ::  dustmo    !: set of dust fields 
    63    REAL(wp), DIMENSION(jpi,jpj)      ::  rivinp, cotdep, nitdep, dust  
    64    REAL(wp), DIMENSION(jpi,jpj)      ::  e1e2t 
    65    REAL(wp), DIMENSION(jpi,jpj,jpk)  ::  ironsed  
     47   REAL(wp) :: ryyss                  !: number of seconds per year  
     48   REAL(wp) :: ryyss1                 !: inverse of ryyss 
     49   REAL(wp) :: rmtss                  !: number of seconds per month 
     50   REAL(wp) :: rday1                  !: inverse of rday 
     51 
     52   INTEGER , PARAMETER :: jpmth = 12  !: number of months per year 
     53   INTEGER , PARAMETER :: jpyr  = 1   !: one year 
     54 
     55   INTEGER ::  numdust                !: logical unit for surface fluxes data 
     56   INTEGER ::  nflx1 , nflx2          !: first and second record used 
     57   INTEGER ::  nflx11, nflx12 
     58 
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo    !: set of dust fields 
     60   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust      !: dust fields 
     61   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivinp, cotdep    !: river input fields 
     62   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition  
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed   !: Coastal supply of iron 
     64 
    6665   REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput 
    6766 
     
    7675CONTAINS 
    7776 
     77 
    7878   SUBROUTINE p4z_sed( kt, jnt ) 
    7979      !!--------------------------------------------------------------------- 
     
    8686      !! ** Method  : - ??? 
    8787      !!--------------------------------------------------------------------- 
     88      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     89      USE wrk_nemo, ONLY: zsidep => wrk_2d_1, zwork => wrk_2d_2, zwork1 => wrk_2d_3 
     90      USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_3 
     91      ! 
    8892      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    8993      INTEGER  ::   ji, jj, jk, ikt 
     
    9498      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact 
    9599      REAL(wp) ::   zwsbio3, zwsbio4, zwscal 
    96       REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep 
    97       REAL(wp), DIMENSION(jpi,jpj)     ::   zwork, zwork1 
    98       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep 
    99100      CHARACTER (len=25) :: charout 
    100101      !!--------------------------------------------------------------------- 
     102 
     103      IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN 
     104         CALL ctl_stop('p4z_sed: requested workspace arrays unavailable')  ;  RETURN 
     105      END IF 
    101106 
    102107      IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt ) 
     
    288293       ENDIF 
    289294 
     295      IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3) ) )   & 
     296        &         CALL ctl_stop('p4z_sed: failed to release workspace arrays') 
     297 
    290298   END SUBROUTINE p4z_sed 
    291299 
     
    474482      ryyss1 = 1. / ryyss 
    475483      !                                    ! ocean surface cell 
    476       e1e2t(:,:) = e1t(:,:) * e2t(:,:) 
    477484 
    478485      ! total atmospheric supply of Si 
     
    512519   END SUBROUTINE p4z_sed_init 
    513520 
     521   INTEGER FUNCTION p4z_sed_alloc() 
     522      !!---------------------------------------------------------------------- 
     523      !!                     ***  ROUTINE p4z_sed_alloc  *** 
     524      !!---------------------------------------------------------------------- 
     525 
     526      ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj)       ,     & 
     527        &       rivinp(jpi,jpj)      , cotdep(jpi,jpj)     ,     & 
     528        &       nitdep(jpi,jpj)      , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )   
     529 
     530      IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.') 
     531 
     532   END FUNCTION p4z_sed_alloc 
    514533#else 
    515534   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r2528 r2715  
    2121   PUBLIC   p4z_sink         ! called in p4zbio.F90 
    2222   PUBLIC   p4z_sink_init    ! called in trcsms_pisces.F90 
    23  
    24    !! * Shared module variables 
    25    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    26      wsbio3, wsbio4,      &    !: POC and GOC sinking speeds 
    27      wscal                     !: Calcite and BSi sinking speeds 
    28  
    29    !! * Module variables 
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    31      sinking, sinking2,   &    !: POC sinking fluxes (different meanings depending on the parameterization 
    32      sinkcal, sinksil,    &    !: CaCO3 and BSi sinking fluxes 
    33      sinkfer                   !: Small BFe sinking flux 
    34  
    35    INTEGER  :: & 
    36       iksed  = 10              ! 
     23   PUBLIC   p4z_sink_alloc 
     24 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed  
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds 
     28 
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinking, sinking2  !: POC sinking fluxes  
     30   !                                                          !  (different meanings depending on the parameterization) 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer            !: Small BFe sinking fluxes 
     33#if ! defined key_kriest 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer2           !: Big iron sinking fluxes 
     35#endif 
     36 
     37   INTEGER  :: iksed  = 10 
    3738 
    3839#if  defined key_kriest 
    39    REAL(wp)          ::       &    
    40       xkr_sfact    = 250.  ,  &   !: Sinking factor 
    41       xkr_stick    = 0.2   ,  &   !: Stickiness 
    42       xkr_nnano    = 2.337 ,  &   !: Nbr of cell in nano size class 
    43       xkr_ndiat    = 3.718 ,  &   !: Nbr of cell in diatoms size class 
    44       xkr_nmeso    = 7.147 ,  &   !: Nbr of cell in mesozoo  size class 
    45       xkr_naggr    = 9.877        !: Nbr of cell in aggregates  size class 
    46  
    47    REAL(wp)          ::       &    
    48       xkr_frac 
    49  
    50    REAL(wp), PUBLIC ::        & 
    51       xkr_dnano            ,  &   !: Size of particles in nano pool 
    52       xkr_ddiat            ,  &   !: Size of particles in diatoms pool 
    53       xkr_dmeso            ,  &   !: Size of particles in mesozoo pool 
    54       xkr_daggr            ,  &   !: Size of particles in aggregates pool 
    55       xkr_wsbio_min        ,  &   !: min vertical particle speed 
    56       xkr_wsbio_max               !: max vertical particle speed 
    57  
    58    REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !: 
    59       xnumm                       !:     maximum number of particles in aggregates 
    60  
    61 #endif 
    62  
    63 #if ! defined key_kriest 
    64    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &   !: 
    65      sinkfer2                  !: Big Fe sinking flux 
    66 #endif  
     40   REAL(wp) ::  xkr_sfact    = 250.     !: Sinking factor 
     41   REAL(wp) ::  xkr_stick    = 0.2      !: Stickiness 
     42   REAL(wp) ::  xkr_nnano    = 2.337    !: Nbr of cell in nano size class 
     43   REAL(wp) ::  xkr_ndiat    = 3.718    !: Nbr of cell in diatoms size class 
     44   REAL(wp) ::  xkr_nmeso    = 7.147    !: Nbr of cell in mesozoo  size class 
     45   REAL(wp) ::  xkr_naggr    = 9.877    !: Nbr of cell in aggregates  size class 
     46 
     47   REAL(wp) ::  xkr_frac  
     48 
     49   REAL(wp), PUBLIC ::  xkr_dnano       !: Size of particles in nano pool 
     50   REAL(wp), PUBLIC ::  xkr_ddiat       !: Size of particles in diatoms pool 
     51   REAL(wp), PUBLIC ::  xkr_dmeso       !: Size of particles in mesozoo pool 
     52   REAL(wp), PUBLIC ::  xkr_daggr       !: Size of particles in aggregates pool 
     53   REAL(wp), PUBLIC ::  xkr_wsbio_min   !: min vertical particle speed 
     54   REAL(wp), PUBLIC ::  xkr_wsbio_max   !: max vertical particle speed 
     55 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   xnumm   !:  maximum number of particles in aggregates 
     57#endif 
    6758 
    6859   !!* Substitution 
     
    7162   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    7263   !! $Id$  
    73    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     64   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7465   !!---------------------------------------------------------------------- 
    75  
    7666CONTAINS 
    7767 
    7868#if defined key_kriest 
     69   !!---------------------------------------------------------------------- 
     70   !!   'key_kriest'                                                    ??? 
     71   !!---------------------------------------------------------------------- 
    7972 
    8073   SUBROUTINE p4z_sink ( kt, jnt ) 
     
    8780      !! ** Method  : - ??? 
    8881      !!--------------------------------------------------------------------- 
    89  
     82      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     83      USE wrk_nemo, ONLY:   znum3d => wrk_3d_2 
     84      ! 
    9085      INTEGER, INTENT(in) :: kt, jnt 
     86      ! 
    9187      INTEGER  :: ji, jj, jk 
    9288      REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 
     
    9995      INTEGER  :: ik1 
    10096#endif 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znum3d 
    10297      CHARACTER (len=25) :: charout 
    103  
    104       !!--------------------------------------------------------------------- 
    105  
     98      !!--------------------------------------------------------------------- 
     99      ! 
     100      IF( wrk_in_use(3, 2 ) ) THEN 
     101         CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')   ;   RETURN 
     102      ENDIF 
     103       
    106104      !     Initialisation of variables used to compute Sinking Speed 
    107105      !     --------------------------------------------------------- 
    108106 
    109        znum3d(:,:,:) = 0.e0 
    110        zval1 = 1. + xkr_zeta 
    111        zval2 = 1. + xkr_zeta + xkr_eta 
    112        zval3 = 1. + xkr_eta 
    113  
    114      !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
    115      !     ----------------------------------------------------------------- 
     107      znum3d(:,:,:) = 0.e0 
     108      zval1 = 1. + xkr_zeta 
     109      zval2 = 1. + xkr_zeta + xkr_eta 
     110      zval3 = 1. + xkr_eta 
     111 
     112      !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
     113      !     ----------------------------------------------------------------- 
    116114 
    117115      DO jk = 1, jpkm1 
     
    131129                  zdiv1 = zeps - zval3 
    132130                  wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv    & 
    133      &                             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv 
     131                     &             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv 
    134132                  wsbio4(ji,jj,jk) = xkr_wsbio_min *   ( zeps-1. )    / zdiv1   & 
    135      &                             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1 
     133                     &             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1 
    136134                  IF( znum == 1.1)   wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk) 
    137135               ENDIF 
     
    140138      END DO 
    141139 
    142       wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. ) 
     140      wscal(:,:,:) = MAX( wsbio3(:,:,:), 50._wp ) 
    143141 
    144142      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
     
    305303#endif 
    306304      ! 
    307        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     305      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    308306         WRITE(charout, FMT="('sink')") 
    309307         CALL prt_ctl_trc_info(charout) 
    310308         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    311        ENDIF 
    312  
     309      ENDIF 
     310      ! 
     311      IF( wrk_not_released(3, 2 ) )   CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
     312      ! 
    313313   END SUBROUTINE p4z_sink 
     314 
    314315 
    315316   SUBROUTINE p4z_sink_init 
     
    324325      !! 
    325326      !! ** input   :   Namelist nampiskrs 
    326       !! 
    327327      !!---------------------------------------------------------------------- 
    328328      INTEGER  ::   jk, jn, kiter 
     
    330330      REAL(wp) ::   zws, zwr, zwl,wmax, znummax 
    331331      REAL(wp) ::   zmin, zmax, zl, zr, xacc 
    332  
     332      ! 
    333333      NAMELIST/nampiskrs/ xkr_sfact, xkr_stick ,  & 
    334334         &                xkr_nnano, xkr_ndiat, xkr_nmeso, xkr_naggr 
    335  
    336335      !!---------------------------------------------------------------------- 
     336      ! 
    337337      REWIND( numnat )                     ! read nampiskrs 
    338338      READ  ( numnat, nampiskrs ) 
     
    347347         WRITE(numout,*) '    Nbr of cell in mesozoo size class        xkr_nmeso    = ', xkr_nmeso 
    348348         WRITE(numout,*) '    Nbr of cell in aggregates size class     xkr_naggr    = ', xkr_naggr 
    349      ENDIF 
    350  
    351  
    352      ! max and min vertical particle speed 
    353      xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
    354      xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
    355      WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
    356  
    357      ! 
    358      !    effect of the sizes of the different living pools on particle numbers 
    359      !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337 
    360      !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718 
    361      !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147 
    362      !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877 
    363      !    doc aggregates = 1um 
    364      ! ---------------------------------------------------------- 
    365  
    366      xkr_dnano = 1. / ( xkr_massp * xkr_nnano ) 
    367      xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat ) 
    368      xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso ) 
    369      xkr_daggr = 1. / ( xkr_massp * xkr_naggr ) 
     349      ENDIF 
     350 
     351 
     352      ! max and min vertical particle speed 
     353      xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
     354      xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
     355      WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
     356 
     357      ! 
     358      !    effect of the sizes of the different living pools on particle numbers 
     359      !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337 
     360      !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718 
     361      !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147 
     362      !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877 
     363      !    doc aggregates = 1um 
     364      ! ---------------------------------------------------------- 
     365 
     366      xkr_dnano = 1. / ( xkr_massp * xkr_nnano ) 
     367      xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat ) 
     368      xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso ) 
     369      xkr_daggr = 1. / ( xkr_massp * xkr_naggr ) 
    370370 
    371371      !!--------------------------------------------------------------------- 
     
    379379      WRITE(numout,*)'    kriest : Compute maximum number of particles in aggregates' 
    380380 
    381       xacc     =  0.001 
     381      xacc     =  0.001_wp 
    382382      kiter    = 50 
    383       zmin     =  1.10 
     383      zmin     =  1.10_wp 
    384384      zmax     = xkr_mass_max / xkr_mass_min 
    385385      xkr_frac = zmax 
     
    402402            &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    403403            & - wmax 
    404 iflag:  DO jn = 1, kiter 
    405            IF( zwl == 0.e0 ) THEN 
    406               znummax = zl 
    407            ELSE IF ( zwr == 0.e0 ) THEN 
    408               znummax = zr 
    409            ELSE 
    410               znummax = ( zr + zl ) / 2. 
    411               zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 
    412               znum = znummax - 1. 
    413               zws =  xkr_wsbio_min * xkr_zeta / zdiv & 
    414                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    415                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    416                  & - wmax 
    417               IF( zws * zwl < 0. ) THEN 
    418                  zr = znummax 
    419               ELSE 
    420                  zl = znummax 
    421               ENDIF 
    422               zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
    423               znum = zl - 1. 
    424               zwl =  xkr_wsbio_min * xkr_zeta / zdiv & 
    425                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    426                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    427                  & - wmax 
    428  
    429               zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 
    430               znum = zr - 1. 
    431               zwr =  xkr_wsbio_min * xkr_zeta / zdiv & 
    432                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    433                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    434                  & - wmax 
    435  
    436               IF ( ABS ( zws )  <= xacc ) EXIT iflag 
    437  
    438            ENDIF 
    439  
    440         END DO iflag 
    441  
    442         xnumm(jk) = znummax 
    443         WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 
    444  
    445      END DO 
    446  
     404iflag:   DO jn = 1, kiter 
     405            IF    ( zwl == 0._wp ) THEN   ;   znummax = zl 
     406            ELSEIF( zwr == 0._wp ) THEN   ;   znummax = zr 
     407            ELSE 
     408               znummax = ( zr + zl ) / 2. 
     409               zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 
     410               znum = znummax - 1. 
     411               zws =  xkr_wsbio_min * xkr_zeta / zdiv & 
     412                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
     413                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
     414                  & - wmax 
     415               IF( zws * zwl < 0. ) THEN   ;   zr = znummax 
     416               ELSE                        ;   zl = znummax 
     417               ENDIF 
     418               zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
     419               znum = zl - 1. 
     420               zwl =  xkr_wsbio_min * xkr_zeta / zdiv & 
     421                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
     422                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
     423                  & - wmax 
     424 
     425               zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 
     426               znum = zr - 1. 
     427               zwr =  xkr_wsbio_min * xkr_zeta / zdiv & 
     428                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
     429                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
     430                  & - wmax 
     431               ! 
     432               IF ( ABS ( zws )  <= xacc ) EXIT iflag 
     433               ! 
     434            ENDIF 
     435            ! 
     436         END DO iflag 
     437 
     438         xnumm(jk) = znummax 
     439         WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 
     440         ! 
     441      END DO 
     442      ! 
    447443  END SUBROUTINE p4z_sink_init 
    448444 
     
    476472         DO jj = 1, jpj 
    477473            DO ji=1,jpi 
    478                zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000. 
     474               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000._wp 
    479475               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    480476            END DO 
     
    584580#endif 
    585581      ! 
    586        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     582      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    587583         WRITE(charout, FMT="('sink')") 
    588584         CALL prt_ctl_trc_info(charout) 
    589585         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    590        ENDIF 
    591  
     586      ENDIF 
     587      ! 
    592588   END SUBROUTINE p4z_sink 
     589 
    593590 
    594591   SUBROUTINE p4z_sink_init 
     
    611608      !!      transport term, i.e.  div(u*tra). 
    612609      !!--------------------------------------------------------------------- 
     610      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     611      USE wrk_nemo, ONLY: ztraz => wrk_3d_2, zakz => wrk_3d_3, zwsink2 => wrk_3d_4 
     612      ! 
    613613      INTEGER , INTENT(in   )                         ::   jp_tra    ! tracer index index       
    614614      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pwsink    ! sinking speed 
     
    617617      INTEGER  ::   ji, jj, jk, jn 
    618618      REAL(wp) ::   zigma,zew,zign, zflx, zstep 
    619       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  ztraz, zakz 
    620       REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zwsink2 
    621       !!--------------------------------------------------------------------- 
    622  
     619      !!--------------------------------------------------------------------- 
     620 
     621      IF(  wrk_in_use(3, 2,3,4 ) ) THEN 
     622         CALL ctl_stop('p4z_sink2: requested workspace arrays unavailable') 
     623         RETURN 
     624      END IF 
    623625 
    624626      zstep = rfact2 / 2. 
     
    701703      END DO 
    702704 
    703       trn(:,:,:,jp_tra) = trb(:,:,:,jp_tra) 
    704       psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
    705  
     705      trn     (:,:,:,jp_tra) = trb(:,:,:,jp_tra) 
     706      psinkflx(:,:,:)        = 2. * psinkflx(:,:,:) 
     707      ! 
     708      IF( wrk_not_released(3, 2,3,4) )   CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 
    706709      ! 
    707710   END SUBROUTINE p4z_sink2 
    708711 
     712 
     713   INTEGER FUNCTION p4z_sink_alloc() 
     714      !!---------------------------------------------------------------------- 
     715      !!                     ***  ROUTINE p4z_sink_alloc  *** 
     716      !!---------------------------------------------------------------------- 
     717      ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4  (jpi,jpj,jpk) , wscal(jpi,jpj,jpk) ,     & 
     718         &      sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                      ,     &                 
     719         &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                      ,     &                 
     720#if defined key_kriest 
     721         &      xnumm(jpk)                                                        ,     &                 
     722#else 
     723         &      sinkfer2(jpi,jpj,jpk)                                             ,     &                 
     724#endif 
     725         &      sinkfer(jpi,jpj,jpk)                                              , STAT=p4z_sink_alloc )                 
     726         ! 
     727      IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 
     728      ! 
     729   END FUNCTION p4z_sink_alloc 
     730    
    709731#else 
    710732   !!====================================================================== 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r2528 r2715  
    77   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style 
    88   !!---------------------------------------------------------------------- 
    9  
    109#if defined key_pisces 
    1110   !!---------------------------------------------------------------------- 
     
    3837   !!* Damping  
    3938   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
    40                                    !: when initialize from a restart file  
    4139   LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
    4240                                   !: on close seas 
    4341 
    4442   !!*  Biological fluxes for light 
    45    INTEGER , DIMENSION(jpi,jpj)     ::   neln       !: number of T-levels + 1 in the euphotic layer 
    46    REAL(wp), DIMENSION(jpi,jpj)     ::   heup       !: euphotic layer depth 
     43   INTEGER , ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  neln       !: number of T-levels + 1 in the euphotic layer 
     44   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  heup       !: euphotic layer depth 
    4745 
    4846   !!*  Biological fluxes for primary production 
    49    REAL(wp), DIMENSION(jpi,jpj)     ::   xksi       !: ??? 
    50    REAL(wp), DIMENSION(jpi,jpj)     ::   xksimax    !: ??? 
    51    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xnanono3   !: ??? 
    52    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiatno3   !: ??? 
    53    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xnanonh4   !: ??? 
    54    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiatnh4   !: ??? 
    55    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimphy    !: ??? 
    56    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimdia    !: ??? 
    57    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   concdfe    !: ??? 
    58    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   concnfe    !: ??? 
     47   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksi       !: ??? 
     48   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksimax    !: ??? 
     49   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnanono3   !: ??? 
     50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiatno3   !: ??? 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnanonh4   !: ??? 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiatnh4   !: ??? 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimphy    !: ??? 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimdia    !: ??? 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   concdfe    !: ??? 
     56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   concnfe    !: ??? 
    5957 
    6058   !!*  SMS for the organic matter 
    61    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xfracal    !: ?? 
    62    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   nitrfac    !: ?? 
    63    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xlimbac    !: ?? 
    64    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   xdiss      !: ?? 
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xfracal    !: ?? 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ?? 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ?? 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ?? 
    6563#if defined key_diatrc 
    66    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prodcal    !: Calcite production 
    67    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazing    !: Total zooplankton grazing 
     64   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
     65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing 
    6866#endif 
    6967 
    7068   !!* Variable for chemistry of the CO2 cycle 
    71    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akb3       !: ??? 
    72    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ak13       !: ??? 
    73    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ak23       !: ??? 
    74    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   aksp       !: ??? 
    75    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   akw3       !: ??? 
    76    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   borat      !: ??? 
    77    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   hi         !: ??? 
     69   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ??? 
     70   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak13       !: ??? 
     71   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak23       !: ??? 
     72   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksp       !: ??? 
     73   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ??? 
     74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
     75   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ??? 
     76 
     77   !!* Array used to indicate negative tracer values 
     78   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ??? 
    7879 
    7980#if defined key_kriest 
     
    8586#endif 
    8687 
     88   !!---------------------------------------------------------------------- 
     89   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     90   !! $Id$  
     91   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     92   !!---------------------------------------------------------------------- 
     93CONTAINS 
     94 
     95   INTEGER FUNCTION sms_pisces_alloc() 
     96      !!---------------------------------------------------------------------- 
     97      !!        *** ROUTINE sms_pisces_alloc *** 
     98      !!---------------------------------------------------------------------- 
     99      USE lib_mpp , ONLY: ctl_warn 
     100      INTEGER ::   ierr(5)        ! Local variables 
     101      !!---------------------------------------------------------------------- 
     102      ierr(:) = 0 
     103      ! 
     104      !*  Biological fluxes for light 
     105      ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                           STAT=ierr(1) ) 
     106      ! 
     107      !*  Biological fluxes for primary production 
     108      ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,               & 
     109         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),               & 
     110         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),               & 
     111         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),               & 
     112         &      concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk),           STAT=ierr(2) )  
     113         ! 
     114      !*  SMS for the organic matter 
     115      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk),               & 
     116#if defined key_diatrc 
     117         &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk) ,               & 
     118#endif  
     119         &      xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk)   ,           STAT=ierr(3) )   
     120         ! 
     121      !* Variable for chemistry of the CO2 cycle 
     122      ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) ,                      & 
     123         &      ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) ,                      & 
     124         &      akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 
     125         ! 
     126      !* Array used to indicate negative tracer values   
     127      ALLOCATE( xnegtr(jpi,jpj,jpk),                                    STAT=ierr(5) ) 
     128      ! 
     129      sms_pisces_alloc = MAXVAL( ierr ) 
     130      ! 
     131      IF( sms_pisces_alloc /= 0 )   CALL ctl_warn('sms_pisces_alloc: failed to allocate arrays')  
     132      ! 
     133   END FUNCTION sms_pisces_alloc 
     134 
    87135#else 
    88136   !!----------------------------------------------------------------------    
     
    91139#endif 
    92140    
    93    !!---------------------------------------------------------------------- 
    94    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    95    !! $Id$  
    96    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    97141   !!======================================================================    
    98142END MODULE sms_pisces     
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r2528 r2715  
    2121   USE oce_trc         ! ocean variables 
    2222   USE p4zche  
    23    USE lib_mpp 
     23   USE p4zche          !  
     24   USE p4zsink         !  
     25   USE p4zopt          !  
     26   USE p4zprod         ! 
     27   USE p4zrem          !  
     28   USE p4zsed          !  
     29   USE p4zflx          !  
    2430 
    2531   IMPLICIT NONE 
     
    2834   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module 
    2935 
    30    !! * Module variables 
    31    REAL(wp) :: & 
    32       sco2   =  2.312e-3         , & 
    33       alka0  =  2.423e-3         , & 
    34       oxyg0  =  177.6e-6         , & 
    35       po4    =  2.174e-6         , & 
    36       bioma0 =  1.000e-8         , & 
    37       silic1 =  91.65e-6         , & 
    38       no3    =  31.04e-6 * 7.6 
     36   REAL(wp) :: sco2   =  2.312e-3_wp 
     37   REAL(wp) :: alka0  =  2.423e-3_wp 
     38   REAL(wp) :: oxyg0  =  177.6e-6_wp  
     39   REAL(wp) :: po4    =  2.174e-6_wp  
     40   REAL(wp) :: bioma0 =  1.000e-8_wp   
     41   REAL(wp) :: silic1 =  91.65e-6_wp   
     42   REAL(wp) :: no3    =  31.04e-6_wp * 7.6_wp 
    3943 
    4044#  include "top_substitute.h90" 
     
    4246   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4347   !! $Id$  
    44    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4549   !!---------------------------------------------------------------------- 
    46  
    4750CONTAINS 
    4851 
     
    5356      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    5457      !!---------------------------------------------------------------------- 
    55  
    56  
    57       !  Control consitency 
    58       CALL trc_ctl_pisces 
    59  
    60  
     58      ! 
    6159      IF(lwp) WRITE(numout,*) 
    6260      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
    6361      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     62 
     63      CALL pisces_alloc()                          ! Allocate PISCES arrays 
    6464 
    6565      !                                            ! Time-step 
     
    126126      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    127127      IF(lwp) WRITE(numout,*) ' ' 
    128  
    129128      ! 
    130129   END SUBROUTINE trc_ini_pisces 
    131   
    132    SUBROUTINE trc_ctl_pisces 
     130 
     131 
     132   SUBROUTINE pisces_alloc 
    133133      !!---------------------------------------------------------------------- 
    134       !!                     ***  ROUTINE trc_ctl_pisces  *** 
     134      !!                     ***  ROUTINE pisces_alloc  *** 
    135135      !! 
    136       !! ** Purpose :   control the cpp options, namelist and files  
     136      !! ** Purpose :   Allocate all the dynamic arrays of PISCES  
    137137      !!---------------------------------------------------------------------- 
     138      USE p4zint , ONLY : p4z_int_alloc       
     139      USE p4zsink, ONLY : p4z_sink_alloc       
     140      USE p4zopt , ONLY : p4z_opt_alloc            
     141      USE p4zprod, ONLY : p4z_prod_alloc          
     142      USE p4zrem , ONLY : p4z_rem_alloc            
     143      USE p4zsed , ONLY : p4z_sed_alloc           
     144      USE p4zflx , ONLY : p4z_flx_alloc 
     145      ! 
     146      INTEGER :: ierr 
     147      !!---------------------------------------------------------------------- 
     148      ! 
     149      ierr =         sms_pisces_alloc()          ! Start of PISCES-related alloc routines... 
     150      ierr = ierr +     p4z_che_alloc() 
     151      ierr = ierr +     p4z_int_alloc() 
     152      ierr = ierr +    p4z_sink_alloc() 
     153      ierr = ierr +     p4z_opt_alloc() 
     154      ierr = ierr +    p4z_prod_alloc() 
     155      ierr = ierr +     p4z_rem_alloc() 
     156      ierr = ierr +     p4z_sed_alloc() 
     157      ierr = ierr +     p4z_flx_alloc() 
     158      ! 
     159      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     160      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 
     161      ! 
     162   END SUBROUTINE pisces_alloc 
    138163 
    139       IF(lwp) WRITE(numout,*) 
    140       IF(lwp) WRITE(numout,*) ' use PISCES biological model ' 
    141  
    142    ! Check number of tracers 
    143    ! ----------------------- 
    144 #if  defined key_kriest 
    145       IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' ) 
    146 #else 
    147       IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' ) 
    148 #endif 
    149  
    150    END SUBROUTINE trc_ctl_pisces 
    151    
    152164#else 
    153165   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r2567 r2715  
    1919   USE trc             ! TOP variables 
    2020   USE sms_pisces      ! sms trends 
    21    USE in_out_manager  ! I/O manager 
    2221 
    2322 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    r2528 r2715  
    1818   USE trcsms_pisces          ! pisces sms trends 
    1919   USE sms_pisces          ! pisces sms variables 
    20    USE in_out_manager  ! I/O manager 
    2120   USE iom 
    2221   USE trcdta 
    23    USE lib_mpp 
    24    USE lib_fortran 
    2522 
    2623   IMPLICIT NONE 
     
    108105      !! ** purpose  : Relaxation of some tracers 
    109106      !!---------------------------------------------------------------------- 
    110       INTEGER  :: ji, jj, jk 
    111       REAL(wp) ::  & 
    112          alkmean = 2426. ,  & ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    113          po4mean = 2.165 ,  & ! mean value of phosphates 
    114          no3mean = 30.90 ,  & ! mean value of nitrate 
    115          silmean = 91.51      ! mean value of silicate 
    116  
    117       REAL(wp) :: zarea, zvol, zalksum, zpo4sum, zno3sum, zsilsum 
     107      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
     108      REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates 
     109      REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate 
     110      REAL(wp) ::  silmean = 91.51     ! mean value of silicate 
     111 
     112      REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 
    118113 
    119114 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r2528 r2715  
    1616   USE trc 
    1717   USE sms_pisces 
    18    USE lbclnk 
    19    USE lib_mpp 
    2018    
    2119   USE p4zint          !  
     
    6563      !!              - ... 
    6664      !!--------------------------------------------------------------------- 
     65      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     66      USE wrk_nemo, ONLY: ztrpis => wrk_3d_1   ! used for pisces sms trends 
     67      ! 
    6768      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    6869      !! 
    6970      INTEGER ::   jnt, jn 
    70       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztrpis   ! used for pisces sms trends 
    7171      CHARACTER (len=25) :: charout 
    7272      !!--------------------------------------------------------------------- 
    7373 
    7474      IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
     75 
     76      IF( wrk_in_use(3,1) )  THEN 
     77        CALL ctl_stop('trc_sms_pisces : requested workspace array unavailable.')  ;  RETURN 
     78      ENDIF 
    7579 
    7680      IF( ndayflxtr /= nday_year ) THEN      ! New days 
     
    111115            CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends 
    112116          END DO 
     117          DEALLOCATE( ztrpis ) 
    113118      END IF 
    114119 
     
    122127         ! 
    123128      ENDIF 
     129 
     130      IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.')  
    124131 
    125132   END SUBROUTINE trc_sms_pisces 
  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90

    r2528 r2715  
    1717   USE sedarr 
    1818   USE iom 
    19    USE in_out_manager  ! I/O manager 
    2019 
    2120 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r2528 r2715  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_top'                                                TOP models 
    12    !!---------------------------------------------------------------------- 
    1312   !!---------------------------------------------------------------------- 
    1413   !!   trc_adv      : compute ocean tracer advection trend 
     
    2625   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    2726   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    28    USE in_out_manager  ! I/O manager 
    29    USE prtctl_trc          ! Print control 
     27   USE prtctl_trc      ! Print control 
    3028 
    3129   IMPLICIT NONE 
    3230   PRIVATE 
    3331 
    34    PUBLIC   trc_adv    ! routine called by step module 
     32   PUBLIC   trc_adv          ! routine called by step module 
     33   PUBLIC   trc_adv_alloc    ! routine called by nemogcm module 
    3534 
    3635   INTEGER ::   nadv   ! choice of the type of advection scheme 
    37    REAL(wp), DIMENSION(jpk) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    38       !                                ! except at nit000 (=rdttra) if neuler=0 
     36   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
     37   !                                                    ! except at nit000 (=rdttra) if neuler=0 
    3938 
    4039   !! * Substitutions 
     
    4645   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4746   !!---------------------------------------------------------------------- 
    48  
    4947CONTAINS 
     48 
     49   INTEGER FUNCTION trc_adv_alloc() 
     50      !!---------------------------------------------------------------------- 
     51      !!                  ***  ROUTINE trc_adv_alloc  *** 
     52      !!---------------------------------------------------------------------- 
     53 
     54      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
     55 
     56      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
     57 
     58   END FUNCTION trc_adv_alloc 
     59 
    5060 
    5161   SUBROUTINE trc_adv( kt ) 
     
    5767      !! ** Method  : - Update the tracer with the advection term following nadv 
    5868      !!---------------------------------------------------------------------- 
     69      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     70      USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, zwn => wrk_3d_6   ! effective velocity 
    5971      !! 
    60       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    61       ! 
    62       INTEGER :: jk  
    63       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn   ! effective velocity 
    64       CHARACTER (len=22) :: charout 
    65       !!---------------------------------------------------------------------- 
     72      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     73      ! 
     74      INTEGER ::   jk  
     75      CHARACTER (len=22) ::   charout 
     76      !!---------------------------------------------------------------------- 
     77      ! 
     78      IF( wrk_in_use(3, 4,5,6) ) THEN 
     79         CALL ctl_stop('trc_adv : requested workspace arrays unavailable')   ;   RETURN 
     80      ENDIF 
    6681 
    6782      IF( kt == nit000 )   CALL trc_adv_ctl          ! initialisation & control of options 
     
    8095      DO jk = 1, jpkm1 
    8196         !                                                ! eulerian transport only 
    82          zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    83          zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    84          zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk) 
     97         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     98         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     99         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    85100         ! 
    86101      END DO 
     
    125140                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    126141      END IF 
     142      ! 
     143      IF( wrk_not_released(3, 4,5,6) ) CALL ctl_stop('trc_adv : failed to release workspace arrays.') 
    127144      ! 
    128145   END SUBROUTINE trc_adv 
     
    171188      ! 
    172189   END SUBROUTINE trc_adv_ctl 
     190    
    173191#else 
    174192   !!---------------------------------------------------------------------- 
     
    181199   END SUBROUTINE trc_adv 
    182200#endif 
     201 
    183202  !!====================================================================== 
    184203END MODULE trcadv 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r2528 r2715  
    2929   PRIVATE 
    3030 
    31    PUBLIC trc_dmp      ! routine called by step.F90 
     31   PUBLIC trc_dmp            ! routine called by step.F90 
     32   PUBLIC trc_dmp_alloc      ! routine called by nemogcm.F90 
    3233 
    3334   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag 
    34    !                             !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
     35 
     36   !                                !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
    3537   INTEGER  ::   nn_hdmp_tr =   -1   ! = 0/-1/'latitude' for damping over passive tracer 
    3638   INTEGER  ::   nn_zdmp_tr =    0   ! = 0/1/2 flag for damping in the mixed layer 
     
    4042   INTEGER  ::   nn_file_tr =    2   ! = 1 create a damping.coeff NetCDF file  
    4143 
    42    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   restotr   ! restoring coeff. on tracers (s-1) 
     44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   restotr   ! restoring coeff. on tracers (s-1) 
    4345 
    4446   !! * Substitutions 
     
    4749   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4850   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $  
    49    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    50    !!---------------------------------------------------------------------- 
    51  
     51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     52   !!---------------------------------------------------------------------- 
    5253CONTAINS 
     54 
     55   INTEGER FUNCTION trc_dmp_alloc() 
     56      !!---------------------------------------------------------------------- 
     57      !!                   ***  ROUTINE trc_dmp_alloc  *** 
     58      !!---------------------------------------------------------------------- 
     59      ALLOCATE( restotr(jpi,jpj,jpk) , STAT=trc_dmp_alloc ) 
     60      ! 
     61      IF( trc_dmp_alloc /= 0 )   CALL ctl_warn('trc_dmp_alloc: failed to allocate array') 
     62      ! 
     63   END FUNCTION trc_dmp_alloc 
     64 
    5365 
    5466   SUBROUTINE trc_dmp( kt ) 
     
    161173      !! 
    162174      !! ** Method  :   read the nammbf namelist and check the parameters 
    163       !!      called by trc_dmp at the first timestep (nit000) 
     175      !!              called by trc_dmp at the first timestep (nit000) 
    164176      !!---------------------------------------------------------------------- 
    165177 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r2528 r2715  
    2727   USE trdtra 
    2828   USE prtctl_trc      ! Print control 
    29    USE in_out_manager  ! I/O manager 
    30    USE lib_mpp         ! distribued memory computing library 
    31    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3229 
    3330   IMPLICIT NONE 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r2528 r2715  
    33   !!                       ***  MODULE  trcnxt  *** 
    44   !! Ocean passive tracers:  time stepping on passives tracers 
    5    !!====================================================================== 
    65   !!====================================================================== 
    76   !! History :  7.0  !  1991-11  (G. Madec)  Original code 
     
    2726   !!   trc_nxt     : time stepping on passive tracers 
    2827   !!---------------------------------------------------------------------- 
    29    !! * Modules used 
    3028   USE oce_trc         ! ocean dynamics and tracers variables 
    3129   USE trc             ! ocean passive tracers variables 
     
    4341   PRIVATE 
    4442 
    45    !! * Routine accessibility 
    46    PUBLIC trc_nxt          ! routine called by step.F90 
     43   PUBLIC   trc_nxt          ! routine called by step.F90 
     44   PUBLIC   trc_nxt_alloc    ! routine called by nemogcm.F90 
    4745 
    48   REAL(wp), DIMENSION(jpk) ::   r2dt 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt 
     47 
    4948   !!---------------------------------------------------------------------- 
    5049   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5150   !! $Id$  
    52    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5352   !!---------------------------------------------------------------------- 
     53CONTAINS 
    5454 
    55 CONTAINS 
     55   INTEGER FUNCTION trc_nxt_alloc() 
     56      !!---------------------------------------------------------------------- 
     57      !!                   ***  ROUTINE trc_nxt_alloc  *** 
     58      !!---------------------------------------------------------------------- 
     59      ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc ) 
     60      ! 
     61      IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array') 
     62      ! 
     63   END FUNCTION trc_nxt_alloc 
     64 
    5665 
    5766   SUBROUTINE trc_nxt( kt ) 
     
    7988      !! ** Action  : - update trb, trn 
    8089      !!---------------------------------------------------------------------- 
    81       !! * Arguments 
    8290      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    83       !! * Local declarations 
     91      ! 
    8492      INTEGER  ::   jk, jn   ! dummy loop indices 
    8593      REAL(wp) ::   zfact            ! temporary scalar 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r2528 r2715  
    1717   USE trdmod_oce 
    1818   USE trdtra 
    19    USE lib_mpp 
    2019   USE prtctl_trc          ! Print control for debbuging 
    2120 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r2528 r2715  
    1616   !!   trc_sbc      : update the tracer trend at ocean surface 
    1717   !!---------------------------------------------------------------------- 
    18    !! * Modules used 
    19    USE oce_trc             ! ocean dynamics and active tracers variables 
    20    USE trc                 ! ocean  passive tracers variables 
    21    USE prtctl_trc          ! Print control for debbuging 
     18   USE oce_trc         ! ocean dynamics and active tracers variables 
     19   USE trc             ! ocean  passive tracers variables 
     20   USE prtctl_trc      ! Print control for debbuging 
    2221   USE trdmod_oce 
    2322   USE trdtra 
     
    2625   PRIVATE 
    2726 
    28    !! * Routine accessibility 
    29    PUBLIC trc_sbc              ! routine called by step.F90 
     27   PUBLIC   trc_sbc   ! routine called by step.F90 
    3028 
    3129   !! * Substitutions 
     
    3432   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3533   !! $Id$  
    36    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3735   !!---------------------------------------------------------------------- 
    38  
    3936CONTAINS 
    4037 
     
    6057      !! 
    6158      !!---------------------------------------------------------------------- 
    62       !! * Arguments 
     59      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     60      USE wrk_nemo, ONLY:   zemps  => wrk_2d_1 
     61      USE wrk_nemo, ONLY:   ztrtrd => wrk_3d_1 
     62      ! 
    6363      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    64  
    65       !! * Local declarations 
     64      ! 
    6665      INTEGER  ::   ji, jj, jn           ! dummy loop indices 
    6766      REAL(wp) ::   zsrau, zse3t   ! temporary scalars 
    68       REAL(wp), DIMENSION(jpi,jpj) ::   zemps  ! surface freshwater flux 
    69       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    7067      CHARACTER (len=22) :: charout 
    7168      !!---------------------------------------------------------------------- 
     69 
     70      IF( wrk_in_use(2, 1) .OR.  wrk_in_use(3, 1) ) THEN 
     71         CALL ctl_stop('trc_sbc: requested workspace array unavailable.')   ;   RETURN 
     72      END IF 
    7273 
    7374      IF( kt == nit000 ) THEN 
     
    7778      ENDIF 
    7879 
    79  
    80       IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    8180 
    8281      IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf 
     
    113112      END DO                                                     ! tracer loop 
    114113      !                                                          ! =========== 
    115       IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    116  
    117114      IF( ln_ctl )   THEN 
    118115         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
    119116                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    120117      ENDIF 
     118 
     119      IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )   & 
     120      &       CALL ctl_stop('trc_sbc: failed to release workspace array.') 
    121121 
    122122   END SUBROUTINE trc_sbc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r2528 r2715  
    1111   !!   'key_top'                                                TOP models 
    1212   !!---------------------------------------------------------------------- 
    13    !!---------------------------------------------------------------------- 
    1413   !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    1514   !!       ldf_ctl : initialization, namelist read, and parameters control 
     
    2019   USE trazdf_exp      ! vertical diffusion: explicit (tra_zdf_exp     routine) 
    2120   USE trazdf_imp      ! vertical diffusion: implicit (tra_zdf_imp     routine) 
    22    USE prtctl_trc      ! Print control 
    23    USE in_out_manager  ! I/O manager 
    24    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2521   USE trdmod_oce 
    2622   USE trdtra 
     23   USE prtctl_trc      ! Print control 
    2724 
    2825   IMPLICIT NONE 
    2926   PRIVATE 
    3027 
    31    PUBLIC   trc_zdf    ! called by step.F90  
     28   PUBLIC   trc_zdf          ! called by step.F90  
     29   PUBLIC   trc_zdf_alloc    ! called by nemogcm.F90  
    3230 
    3331   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    3432      !                                ! defined from ln_zdf...  namlist logicals) 
    35    REAL(wp), DIMENSION(jpk) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
    36       !                                ! except at nit000 (=rdttra) if neuler=0 
     33   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
     34      !                                                 ! except at nit000 (=rdttra) if neuler=0 
    3735 
    3836   !! * Substitutions 
     
    4341   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4442   !! $Id$  
    45    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4644   !!---------------------------------------------------------------------- 
    47  
    4845CONTAINS 
    4946    
     47   INTEGER FUNCTION trc_zdf_alloc() 
     48      !!---------------------------------------------------------------------- 
     49      !!                  ***  ROUTINE trc_zdf_alloc  *** 
     50      !!---------------------------------------------------------------------- 
     51      ALLOCATE( r2dt(jpk) , STAT=trc_zdf_alloc ) 
     52      ! 
     53      IF( trc_zdf_alloc /= 0 )   CALL ctl_warn('trc_zdf_alloc : failed to allocate array.') 
     54      ! 
     55   END FUNCTION trc_zdf_alloc 
     56 
     57 
    5058   SUBROUTINE trc_zdf( kt ) 
    5159      !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    r2528 r2715  
    2323   USE zdfddm  , ONLY : avs  !: salinity vertical diffusivity coeff. at w-point 
    2424# endif 
    25    USE trcnam_trp      ! passive tracers transport namelist variables 
     25   USE trcnam_trp        ! passive tracers transport namelist variables 
    2626   USE trdmod_trc_oce    ! definition of main arrays used for trends computations 
    2727   USE in_out_manager    ! I/O manager 
     
    3030   USE ioipsl            ! NetCDF library 
    3131   USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
     32   USE lib_mpp           ! MPP library 
    3233   USE trdmld_trc_rst    ! restart for diagnosing the ML trends 
    3334   USE prtctl            ! print control 
     
    3940 
    4041   PUBLIC trd_mld_trc 
     42   PUBLIC trd_mld_trc_alloc 
    4143   PUBLIC trd_mld_bio 
    4244   PUBLIC trd_mld_trc_init 
     
    4648   CHARACTER (LEN=40) ::  clhstnam                                ! name of the trends NetCDF file 
    4749   INTEGER ::   nmoymltrd 
    48    INTEGER ::   ndextrd1(jpi*jpj) 
     50   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1 
    4951   INTEGER, DIMENSION(jptra) ::   nidtrd, nh_t 
    5052   INTEGER ::   ndimtrd1                         
     
    5860   LOGICAL :: lldebug = .TRUE. 
    5961 
     62   ! Workspace array for trd_mld_trc() routine. Declared here as is 4D and 
     63   ! cannot use workspaces in wrk_nemo module. 
     64   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   ! 
     65#if defined key_lobster 
     66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ztmltrdbio2  ! only needed for mean diagnostics in trd_mld_bio() 
     67#endif 
     68 
    6069   !! * Substitutions 
    6170#  include "top_substitute.h90" 
     
    6372   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    6473   !! $Header:  $  
    65    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     74   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6675   !!---------------------------------------------------------------------- 
    67  
    6876CONTAINS 
     77 
     78   INTEGER FUNCTION trd_mld_trc_alloc() 
     79      !!---------------------------------------------------------------------- 
     80      !!                  ***  ROUTINE trd_mld_trc_alloc  *** 
     81      !!---------------------------------------------------------------------- 
     82      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) ,      & 
     83#if defined key_lobster 
     84         &      ztmltrdbio2(jpi,jpj,jpdiabio)      ,      & 
     85#endif 
     86         &      ndextrd1(jpi*jpj)                  ,  STAT=trd_mld_trc_alloc) 
     87         ! 
     88      IF( lk_mpp                )   CALL mpp_sum ( trd_mld_trc_alloc ) 
     89      IF( trd_mld_trc_alloc /=0 )   CALL ctl_warn('trd_mld_trc_alloc: failed to allocate arrays') 
     90      ! 
     91   END FUNCTION trd_mld_trc_alloc 
     92 
    6993 
    7094   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 
     
    88112      !!            surface and the control surface is called "mixed-layer" 
    89113      !!---------------------------------------------------------------------- 
     114      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     115      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1 
     116      !! 
    90117      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank 
    91118      CHARACTER(len=2), INTENT( in ) ::  ctype                    ! surface/bottom (2D) or interior (3D) physics 
    92119      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmld ! passive tracer trend 
    93120      INTEGER ::   ji, jj, jk, isum 
    94       REAL(wp), DIMENSION(jpi,jpj) ::  zvlmsk 
    95       !!---------------------------------------------------------------------- 
     121      !!---------------------------------------------------------------------- 
     122 
     123      IF( wrk_in_use(2, 1) ) THEN 
     124         CALL ctl_stop('trd_mld_trc_zint: requested workspace array unavailable')   ;   RETURN 
     125      ENDIF 
    96126 
    97127      ! I. Definition of control surface and integration weights 
     
    177207            tmltrd_trc(:,:,ktrd,kjn) = tmltrd_trc(:,:,ktrd,kjn) + ptrc_trdmld(:,:,1) * wkx_trc(:,:,1)  ! non penetrative 
    178208      END SELECT 
    179  
    180     END SUBROUTINE trd_mld_trc_zint 
    181      
    182     SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd ) 
     209      ! 
     210      IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_trc_zint: failed to release workspace array') 
     211      ! 
     212   END SUBROUTINE trd_mld_trc_zint 
     213 
     214 
     215   SUBROUTINE trd_mld_bio_zint( ptrc_trdmld, ktrd ) 
    183216      !!---------------------------------------------------------------------- 
    184217      !!                  ***  ROUTINE trd_mld_bio_zint  *** 
     
    198231      !!            surface and the control surface is called "mixed-layer" 
    199232      !!---------------------------------------------------------------------- 
    200       INTEGER, INTENT( in ) ::   ktrd          ! bio trend index 
    201       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmld ! passive trc trend 
     233      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     234      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1 
     235      !! 
     236      INTEGER                         , INTENT(in) ::   ktrd          ! bio trend index 
     237      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   ptrc_trdmld   ! passive trc trend 
    202238#if defined key_lobster 
    203       !! local variables 
     239      ! 
    204240      INTEGER ::   ji, jj, jk, isum 
    205       REAL(wp), DIMENSION(jpi,jpj) ::  zvlmsk 
    206       !!---------------------------------------------------------------------- 
     241      !!---------------------------------------------------------------------- 
     242 
     243      IF( wrk_in_use(2, 1) ) THEN 
     244         CALL ctl_stop('trd_mld_bio_zint: requested workspace array unavailable')   ;   RETURN 
     245      ENDIF 
    207246 
    208247      ! I. Definition of control surface and integration weights 
     
    286325      END DO 
    287326 
    288 #endif 
    289  
    290     END SUBROUTINE trd_mld_bio_zint 
    291  
    292  
    293     SUBROUTINE trd_mld_trc( kt ) 
     327      IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_bio_zint: failed to release workspace array') 
     328#endif 
     329      ! 
     330   END SUBROUTINE trd_mld_bio_zint 
     331 
     332 
     333   SUBROUTINE trd_mld_trc( kt ) 
    294334      !!---------------------------------------------------------------------- 
    295335      !!                  ***  ROUTINE trd_mld_trc  *** 
     
    338378      !!       - See NEMO documentation (in preparation) 
    339379      !!---------------------------------------------------------------------- 
    340       INTEGER, INTENT( in ) ::   kt                               ! ocean time-step index 
     380      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     381      USE wrk_nemo, ONLY:   wrk_3d_1, wrk_3d_2, wrk_3d_3, wrk_3d_4 
     382      USE wrk_nemo, ONLY:   wrk_3d_5, wrk_3d_6, wrk_3d_7, wrk_3d_8, wrk_3d_9 
     383      ! 
     384      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     385      ! 
    341386      INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn 
    342387      REAL(wp) ::   zavt, zfn, zfn2 
    343       !! 
    344       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmltot             ! d(trc)/dt over the anlysis window (incl. Asselin) 
    345       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmlres             ! residual = dh/dt entrainment term 
    346       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmlatf             ! for storage only 
    347       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmlrad             ! for storage only (for trb<0 corr in trcrad) 
    348       !! 
    349       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmltot2            ! -+ 
    350       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmlres2            !  | working arrays to diagnose the trends 
    351       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmltrdm2           !  | associated with the time meaned ML 
    352       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmlatf2            !  | passive tracers 
    353       REAL(wp), DIMENSION(jpi,jpj,jptra) ::   ztmlrad2            !  | (-> for trb<0 corr in trcrad) 
    354       REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  ztmltrd2  ! -+ 
    355       !! 
     388      ! 
     389      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot             ! d(trc)/dt over the anlysis window (incl. Asselin) 
     390      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres             ! residual = dh/dt entrainment term 
     391      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlatf             ! for storage only 
     392      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad             ! for storage only (for trb<0 corr in trcrad) 
     393      ! 
     394      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot2            ! -+ 
     395      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres2            !  | working arrays to diagnose the trends 
     396      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltrdm2           !  | associated with the time meaned ML 
     397      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlatf2            !  | passive tracers 
     398      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad2            !  | (-> for trb<0 corr in trcrad) 
     399      !REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  ztmltrd2  ! -+ 
     400      ! 
    356401      CHARACTER (LEN= 5) ::   clvar 
    357402#if defined key_dimgout 
     
    361406      !!---------------------------------------------------------------------- 
    362407 
    363       IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " ) 
     408      IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9) ) THEN 
     409         CALL ctl_stop('trd_mld_trc : requested workspace arrays unavailable')   ;   RETURN 
     410      ENDIF 
     411      ! Set-up pointers into sub-arrays of workspaces 
     412      ztmltot   => wrk_3d_1(:,:,1:jptra) 
     413      ztmlres   => wrk_3d_2(:,:,1:jptra) 
     414      ztmlatf   => wrk_3d_3(:,:,1:jptra) 
     415      ztmlrad   => wrk_3d_4(:,:,1:jptra) 
     416      ztmltot2  => wrk_3d_5(:,:,1:jptra) 
     417      ztmlres2  => wrk_3d_6(:,:,1:jptra) 
     418      ztmltrdm2 => wrk_3d_7(:,:,1:jptra) 
     419      ztmlatf2  => wrk_3d_8(:,:,1:jptra) 
     420      ztmlrad2  => wrk_3d_9(:,:,1:jptra) 
     421 
     422 
     423      IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " ) 
    364424 
    365425      ! ====================================================================== 
     
    386446 
    387447         DO jn = 1, jptra 
    388          ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 
     448            ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 
    389449            IF( ln_trdtrc(jn) ) & 
    390450                 tmltrd_trc(:,:,jpmld_trc_ldf,jn) = tmltrd_trc(:,:,jpmld_trc_ldf,jn) - tmltrd_trc(:,:,jpmld_trc_zdf,jn) 
     
    847907      IF( lrst_trc )   CALL trd_mld_trc_rst_write( kt )  ! this must be after the array swap above (III.3) 
    848908 
     909      IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9) )   CALL ctl_stop('trd_mld_trc: failed to release workspace arrays') 
     910      ! 
    849911   END SUBROUTINE trd_mld_trc 
    850912 
    851     SUBROUTINE trd_mld_bio( kt ) 
     913 
     914   SUBROUTINE trd_mld_bio( kt ) 
    852915      !!---------------------------------------------------------------------- 
    853916      !!                  ***  ROUTINE trd_mld  *** 
     
    900963      INTEGER  ::  jl, it, itmod 
    901964      LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE. 
    902       REAL(wp), DIMENSION(jpi,jpj,jpdiabio) ::  ztmltrdbio2  ! only needed for mean diagnostics 
    903965      REAL(wp) :: zfn, zfn2 
    904966#if defined key_dimgout 
     
    10851147   END SUBROUTINE trd_mld_bio 
    10861148 
     1149 
    10871150   REAL FUNCTION sum2d( ztab ) 
    10881151      !!---------------------------------------------------------------------- 
     
    10911154      REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::  ztab       
    10921155      !!---------------------------------------------------------------------- 
    1093       sum2d = SUM(ztab(2:jpi-1,2:jpj-1)) 
     1156      sum2d = SUM( ztab(2:jpi-1,2:jpj-1) ) 
    10941157   END FUNCTION sum2d 
     1158 
    10951159 
    10961160   SUBROUTINE trd_mld_trc_init 
     
    13781442   !!   Default option :                                       Empty module 
    13791443   !!---------------------------------------------------------------------- 
    1380  
    13811444CONTAINS 
    1382  
    13831445   SUBROUTINE trd_mld_trc( kt )                                   ! Empty routine 
    13841446      INTEGER, INTENT( in) ::   kt 
    13851447      WRITE(*,*) 'trd_mld_trc: You should not have seen this print! error?', kt 
    13861448   END SUBROUTINE trd_mld_trc 
    1387  
    13881449   SUBROUTINE trd_mld_bio( kt ) 
    13891450      INTEGER, INTENT( in) ::   kt 
    13901451      WRITE(*,*) 'trd_mld_bio: You should not have seen this print! error?', kt 
    13911452   END SUBROUTINE trd_mld_bio 
    1392  
    13931453   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 
    13941454      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank 
     
    14001460      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 
    14011461   END SUBROUTINE trd_mld_trc_zint 
    1402  
    14031462   SUBROUTINE trd_mld_trc_init                                    ! Empty routine 
    14041463      WRITE(*,*) 'trd_mld_trc_init: You should not have seen this print! error?' 
  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90

    r2528 r2715  
    44   !! Ocean trends :   set tracer and momentum trend variables 
    55   !!====================================================================== 
    6    !!---------------------------------------------------------------------- 
    7    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    8    !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $  
    9    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    10    !!---------------------------------------------------------------------- 
    11 #if defined key_top 
     6#if defined key_top   ||   defined key_esopa 
    127   !!---------------------------------------------------------------------- 
    138   !!   'key_top'                                                TOP models 
    149   !!---------------------------------------------------------------------- 
    15  
    16    USE par_oce                        ! ocean parameters 
    17    USE par_trc                        ! passive tracers parameters 
     10   USE par_oce       ! ocean parameters 
     11   USE par_trc       ! passive tracers parameters 
    1812 
    1913   IMPLICIT NONE 
    2014   PUBLIC 
    2115 
    22    !!* Namelist namtoptrd:  diagnostics on passive tracers trends 
    23    INTEGER  ::    nn_trd_trc                 !: time step frequency dynamics and tracers trends 
    24    INTEGER  ::    nn_ctls_trc                !: control surface type for trends vertical integration 
     16   !                                         !!* Namelist namtoptrd:  diagnostics on passive tracers trends 
     17   INTEGER  ::    nn_trd_trc                  !: time step frequency dynamics and tracers trends 
     18   INTEGER  ::    nn_ctls_trc                 !: control surface type for trends vertical integration 
    2519   REAL(wp) ::    rn_ucf_trc                  !: unit conversion factor (for netCDF trends outputs) 
    26    LOGICAL  ::    ln_trdmld_trc_instant    !: flag to diagnose inst./mean ML trc trends 
    27    LOGICAL  ::    ln_trdmld_trc_restart    !: flag to restart mixed-layer trc diagnostics 
    28    CHARACTER(len=50) ::  cn_trdrst_trc_in  !: suffix of pass. tracer restart name (input) 
    29    CHARACTER(len=50) ::  cn_trdrst_trc_out !: suffix of pass. tracer restart name (output) 
    30    LOGICAL, DIMENSION (jptra) ::   ln_trdtrc  !: large trends diagnostic to write or not (namelist) 
     20   LOGICAL  ::    ln_trdmld_trc_instant       !: flag to diagnose inst./mean ML trc trends 
     21   LOGICAL  ::    ln_trdmld_trc_restart       !: flag to restart mixed-layer trc diagnostics 
     22   CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input) 
     23   CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output) 
     24   LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
    3125 
    3226# if defined key_trdtrc && defined key_iomput 
    3327   LOGICAL, PARAMETER ::   lk_trdtrc = .TRUE.  
    34 #else 
     28# else 
    3529   LOGICAL, PARAMETER ::   lk_trdtrc = .FALSE.   !: ML trend flag 
    36 #endif 
     30# endif 
    3731 
    38 #if defined key_trdmld_trc 
     32# if defined key_trdmld_trc   ||   defined key_esopa 
    3933   !!---------------------------------------------------------------------- 
    4034   !!   'key_trdmld_trc'                     mixed layer trends diagnostics 
     
    6054   !! Trends diagnostics parameters 
    6155   !!--------------------------------------------------------------------- 
    62    INTEGER, PARAMETER ::            & 
    63       jpltrd_trc = 12,                  & !: number of mixed-layer trends arrays 
    64       jpktrd_trc = jpk                    !: max level for mixed-layer trends diag. 
     56   INTEGER, PARAMETER :: jpltrd_trc = 12    !: number of mixed-layer trends arrays 
     57       
     58   INTEGER            :: jpktrd_trc         !: max level for mixed-layer trends diag. 
    6559 
    6660   !! Arrays used for diagnosing mixed-layer trends  
     
    6862   CHARACTER(LEN=80) :: clname_trc, ctrd_trc(jpltrd_trc+1,2) 
    6963 
    70    INTEGER, DIMENSION(jpi,jpj) ::   & 
     64   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   & 
    7165      nmld_trc       , &                            !: mixed layer depth indexes  
    7266      nbol_trc                                   !: mixed-layer depth indexes when read from file 
    7367 
    74    REAL(wp), DIMENSION(jpi,jpj,jpk) ::  wkx_trc  !: 
     68   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  wkx_trc  !: 
    7569 
    76    REAL(wp), DIMENSION(jpi,jpj) ::  rmld_trc     !: ML depth (m) corresponding to nmld_trc 
    77    REAL(wp), DIMENSION(jpi,jpj) ::  rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth 
    78    REAL(wp), DIMENSION(jpi,jpj) ::  rmldbn_trc   !: idem 
     70   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmld_trc     !: ML depth (m) corresponding to nmld_trc 
     71   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmld_sum_trc !: needed to compute the leap-frog time mean of ML depth 
     72   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  rmldbn_trc   !: idem 
    7973 
    80    REAL(wp), DIMENSION(jpi,jpj,jptra) ::  & 
     74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  & 
    8175      tml_trc    ,                        &      !: \ "now" mixed layer temperature/salinity 
    8276      tmlb_trc   ,                        &      !: /  and associated "before" fields 
     
    8983                                                 !:     previous analysis period 
    9084                                                  
    91    REAL(wp), DIMENSION(jpi,jpj,jptra) ::  &       
     85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  &       
    9286      tmlatfb_trc, tmlatfn_trc ,          &      !: "before" Asselin contrib. at beginning of the averaging 
    9387                                                 !:     period (i.e. last contrib. from previous such period) 
     
    9892      tmlradm_trc                                !: accumulator for the previous trcrad trend 
    9993 
    100    REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  & 
     94   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  & 
    10195      tmltrd_trc,                         &      !: \ physical contributions to the total trend (for T/S), 
    10296                                                 !: / cumulated over the current analysis window 
     
    10599      tmltrd_csum_ub_trc                         !: before (prev. analysis period) cumulated sum over the 
    106100                                                 !: upper triangle 
    107    REAL(wp), DIMENSION(jpi,jpj,jptra) ::  & 
     101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  & 
    108102      tmltrdm_trc                                !: total cumulative trends over the analysis window 
    109103 
    110 #else 
     104# else 
    111105   LOGICAL, PARAMETER ::   lk_trdmld_trc = .FALSE.   !: ML trend flag 
    112 #endif 
     106# endif 
    113107 
    114 #if defined key_lobster 
     108# if defined key_lobster 
    115109   CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2) 
    116    REAL(wp), DIMENSION(jpi,jpj,jpdiabio) ::  & 
     110   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  & 
    117111      tmltrd_bio,                         &      !: \ biological contributions to the total trend , 
    118112                                                 !: / cumulated over the current analysis window 
     
    122116                                                 !: upper triangle 
    123117#endif 
     118   !!---------------------------------------------------------------------- 
     119   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     120   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $  
     121   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     122   !!---------------------------------------------------------------------- 
     123CONTAINS 
     124 
     125   INTEGER FUNCTION trd_mod_trc_oce_alloc() 
     126      !!---------------------------------------------------------------------- 
     127      !!         *** ROUTINE trd_mod_trc_oce_alloc *** 
     128      !!---------------------------------------------------------------------- 
     129      USE lib_mpp, ONLY: ctl_warn 
     130      INTEGER :: ierr(2) 
     131      !!---------------------------------------------------------------------- 
     132      ierr(:) = 0 
     133      ! 
     134# if defined key_trdmld_trc 
     135      ALLOCATE(nmld_trc(jpi,jpj),          nbol_trc(jpi,jpj),           & 
     136               wkx_trc(jpi,jpj,jpk),       rmld_trc(jpi,jpj),           & 
     137               rmld_sum_trc(jpi,jpj),      rmldbn_trc(jpi,jpj),         & 
     138               tml_trc(jpi,jpj,jptra),     tmlb_trc(jpi,jpj,jptra),     & 
     139               tmlbb_trc(jpi,jpj,jptra),   tmlbn_trc(jpi,jpj,jptra),    & 
     140               tml_sum_trc(jpi,jpj,jptra), tml_sumb_trc(jpi,jpj,jptra), & 
     141               tmltrd_atf_sumb_trc(jpi,jpj,jptra),                      & 
     142               tmltrd_rad_sumb_trc(jpi,jpj,jptra),                      & 
     143               ! 
     144               tmlatfb_trc(jpi,jpj,jptra), tmlatfn_trc(jpi,jpj,jptra),  & 
     145               tmlatfm_trc(jpi,jpj,jptra), tmlradb_trc(jpi,jpj,jptra),  & 
     146               tmlradn_trc(jpi,jpj,jptra), tmlradm_trc(jpi,jpj,jptra),  & 
     147               ! 
     148               tmltrd_trc(jpi,jpj,jpltrd_trc,jptra)         , & 
     149               tmltrd_sum_trc(jpi,jpj,jpltrd_trc,jptra)     , & 
     150               tmltrd_csum_ln_trc(jpi,jpj,jpltrd_trc,jptra) , & 
     151               tmltrd_csum_ub_trc(jpi,jpj,jpltrd_trc,jptra) , & 
     152               ! 
     153               tmltrdm_trc(jpi,jpj,jptra)                   , STAT=ierr(1) ) 
     154#endif 
     155      ! 
     156# if defined key_lobster 
     157      ALLOCATE( tmltrd_bio        (jpi,jpj,jpdiabio) ,     & 
     158         &      tmltrd_sum_bio    (jpi,jpj,jpdiabio) ,     & 
     159         &      tmltrd_csum_ln_bio(jpi,jpj,jpdiabio) ,     & 
     160         &      tmltrd_csum_ub_bio(jpi,jpj,jpdiabio) , STAT=ierr(2) ) 
     161# endif 
     162      ! 
     163      trd_mod_trc_oce_alloc = MAXVAL(ierr) 
     164      ! 
     165      IF( trd_mod_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_mod_trc_oce_alloc: failed to allocate arrays') 
     166      ! 
     167# if defined key_trdmld_trc 
     168      jpktrd_trc = jpk      ! Initialise what used to be a parameter - max level for mixed-layer trends diag. 
     169# endif 
     170      ! 
     171   END FUNCTION trd_mod_trc_oce_alloc 
    124172 
    125173#else 
     
    129177#endif 
    130178 
    131  
     179   !!====================================================================== 
    132180END MODULE trdmod_trc_oce 
  • trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r2528 r2715  
    3333   !* IO manager * 
    3434   USE in_out_manager     
    35                            
     35  
     36   !* MPP library                          
     37   USE lib_mpp  
     38 
     39   !* Fortran utilities                          
     40   USE lib_fortran 
     41 
     42   !* Lateral boundary conditions                          
     43   USE lbclnk 
     44 
    3645   !* physical constants * 
    3746   USE phycst             
     
    8897   USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)   
    8998   USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)    
     99   USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2) 
    90100   USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m) 
    91101   USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m) 
     
    194204 
    195205#endif 
    196    USE lib_mpp , ONLY :   lk_mpp    =>  lk_mpp        !: Mpp flag 
    197206 
    198207   USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection  
  • trunk/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

    r2528 r2715  
    1717   USE par_trc          ! TOP parameters 
    1818   USE oce_trc          ! ocean space and time domain variables 
    19    USE in_out_manager   ! I/O manager 
    20    USE lib_mpp          ! distributed memory computing 
    2119 
    2220   IMPLICIT NONE 
     
    6967      INTEGER                              , INTENT(in), OPTIONAL ::   kdim      ! k- direction for 4D arrays 
    7068      !! 
     69      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask, ztab3d  
    7170      INTEGER  ::   overlap, jn, js, sind, eind, kdir, j_id 
    7271      REAL(wp) ::   zsum, zvctl 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask, ztab3d 
    7472      CHARACTER (len=20), DIMENSION(jptra) ::   cl 
    7573      CHARACTER (len=10) ::   cl2 
    7674      !!---------------------------------------------------------------------- 
    7775 
     76      ALLOCATE( zmask (jpi,jpj,jpk) ) 
     77      ALLOCATE( ztab3d(jpi,jpj,jpk) ) 
    7878      !                                      ! Arrays, scalars initialization  
    7979      overlap       = 0 
     
    150150         ! 
    151151      END DO 
     152      ! 
     153      DEALLOCATE( zmask  ) 
     154      DEALLOCATE( ztab3d ) 
    152155      ! 
    153156   END SUBROUTINE prt_ctl_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r2568 r2715  
    1919   PUBLIC 
    2020 
     21   PUBLIC   trc_alloc   ! called by nemogcm.F90 
     22 
    2123   !! passive tracers names and units (read in namelist) 
    2224   !! -------------------------------------------------- 
     
    3436   !! passive tracers fields (before,now,after) 
    3537   !! -------------------------------------------------- 
    36    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol   !: volume correction -degrad option-  
    3738   REAL(wp), PUBLIC ::   trai                          !: initial total tracer 
    3839   REAL(wp), PUBLIC ::   areatot                       !: total volume  
    39  
    40    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trn   !: traceur concentration for actual time step 
    41    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   tra   !: traceur concentration for next time step 
    42    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) ::   trb   !: traceur concentration for before time step 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:)   ::   cvol   !: volume correction -degrad option-  
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trn    !: traceur concentration for now time step 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   tra    !: traceur concentration for next time step 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trb    !: traceur concentration for before time step 
    4344 
    4445   !! interpolated gradient 
    4546   !!--------------------------------------------------   
    46    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtru   !: horizontal gradient at u-points at bottom ocean level 
    47    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) ::   gtrv   !: horizontal gradient at v-points at bottom ocean level 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtru   !: hor. gradient at u-points at bottom ocean level 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtrv   !: hor. gradient at v-points at bottom ocean level 
    4849    
    4950   !! passive tracers restart (input and output) 
    5051   !! ------------------------------------------   
    51    LOGICAL , PUBLIC          ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
    52    LOGICAL , PUBLIC          ::  lrst_trc      !: logical to control the trc restart write 
    53    INTEGER , PUBLIC          ::  nn_dttrc      !: frequency of step on passive tracers 
    54    INTEGER , PUBLIC          ::  nutwrs        !: output FILE for passive tracers restart 
    55    INTEGER , PUBLIC          ::  nutrst        !: logical unit for restart FILE for passive tracers 
    56    INTEGER , PUBLIC          ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
    57    CHARACTER(len=50), PUBLIC ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
    58    CHARACTER(len=50), PUBLIC ::  cn_trcrst_out !: suffix of pass. tracer restart name (output) 
     52   LOGICAL          , PUBLIC ::  ln_rsttr        !: boolean term for restart i/o for passive tracers (namelist) 
     53   LOGICAL          , PUBLIC ::  lrst_trc        !: logical to control the trc restart write 
     54   INTEGER          , PUBLIC ::  nn_dttrc        !: frequency of step on passive tracers 
     55   INTEGER          , PUBLIC ::  nutwrs          !: output FILE for passive tracers restart 
     56   INTEGER          , PUBLIC ::  nutrst          !: logical unit for restart FILE for passive tracers 
     57   INTEGER          , PUBLIC ::  nn_rsttr        !: control of the time step ( 0 or 1 ) for pass. tr. 
     58   CHARACTER(len=50), PUBLIC ::  cn_trcrst_in    !: suffix of pass. tracer restart name (input) 
     59   CHARACTER(len=50), PUBLIC ::  cn_trcrst_out   !: suffix of pass. tracer restart name (output) 
    5960    
    6061   !! information for outputs 
    6162   !! -------------------------------------------------- 
    6263   INTEGER , PUBLIC ::   nn_writetrc   !: time step frequency for concentration outputs (namelist) 
    63    REAL(wp), PUBLIC, DIMENSION(jpk) ::   rdttrc        !: vertical profile of passive tracer time step 
     64   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttrc        !: vertical profile of passive tracer time step 
    6465    
    6566# if defined key_diatrc && ! defined key_iomput 
    6667   !! additional 2D/3D outputs namelist 
    6768   !! -------------------------------------------------- 
    68    INTEGER , PUBLIC                               ::   nn_writedia   !: frequency of additional arrays outputs(namelist) 
    69    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d      !: 2d output field name 
    70    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u      !: 2d output field unit    
    71    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d      !: 3d output field name 
    72    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u      !: 3d output field unit 
    73    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l      !: 2d output field long name 
    74    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3l      !: 3d output field long name 
     69   INTEGER         , PUBLIC                      ::   nn_writedia   !: frequency of additional arrays outputs(namelist) 
     70   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2d      !: 2d output field name 
     71   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2u      !: 2d output field unit    
     72   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3d      !: 3d output field name 
     73   CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3u      !: 3d output field unit 
     74   CHARACTER(len=80), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2l      !: 2d output field long name 
     75   CHARACTER(len=80), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3l      !: 3d output field long name 
    7576 
    76    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,    jpdia2d) ::   trc2d    !:  additional 2d outputs   
    77    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) ::   trc3d    !:  additional 3d outputs   
    78     
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d    !:  additional 2d outputs   
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d    !:  additional 3d outputs   
    7979# endif 
    8080 
    81 #if defined key_diabio || defined key_trdmld_trc 
     81# if defined key_diabio || defined key_trdmld_trc 
    8282   !                                                              !!*  namtop_XXX namelist * 
    8383   INTEGER , PUBLIC                               ::   nn_writebio   !: time step frequency for biological outputs  
     
    8585   CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) ::   ctrbiu      !: biological trends unit    
    8686   CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) ::   ctrbil      !: biological trends long name 
    87 #endif 
     87# endif 
    8888# if defined key_diabio 
    8989   !! Biological trends 
    9090   !! ----------------- 
    91    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio   !: biological trends 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trbio   !: biological trends 
    9292# endif 
    9393 
     
    9999# endif 
    100100 
     101   !!---------------------------------------------------------------------- 
     102   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
     103   !! $Id$  
     104   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     105   !!---------------------------------------------------------------------- 
     106CONTAINS 
     107 
     108   INTEGER FUNCTION trc_alloc() 
     109      !!------------------------------------------------------------------- 
     110      !!                    *** ROUTINE trc_alloc *** 
     111      !!------------------------------------------------------------------- 
     112      USE lib_mpp, ONLY: ctl_warn 
     113      !!------------------------------------------------------------------- 
     114      ! 
     115      ALLOCATE( cvol(jpi,jpj,jpk      ) ,                           & 
     116         &      trn (jpi,jpj,jpk,jptra) ,                           & 
     117         &      tra (jpi,jpj,jpk,jptra) ,                           & 
     118         &      trb (jpi,jpj,jpk,jptra) ,                           & 
     119         &      gtru(jpi,jpj    ,jptra) , gtrv(jpi,jpj,jptra) ,     & 
     120# if defined key_diatrc && ! defined key_iomput 
     121         &      trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 
     122# endif 
     123# if defined key_diabio 
     124         &      trbio(jpi,jpj,jpk,jpdiabio),                        & 
     125#endif 
     126               rdttrc(jpk) ,  STAT=trc_alloc )       
     127 
     128      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 
     129      ! 
     130   END FUNCTION trc_alloc 
     131 
    101132#else 
    102133   !!---------------------------------------------------------------------- 
     
    105136#endif 
    106137 
    107    !!---------------------------------------------------------------------- 
    108    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    109    !! $Id$  
    110    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    111138   !!====================================================================== 
    112139END MODULE trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r2567 r2715  
    2525   USE par_trc 
    2626   USE dianam    ! build name of file (routine) 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_mpp 
    2927   USE ioipsl 
    3028 
     
    3230   PRIVATE 
    3331 
    34    PUBLIC   trc_dia   ! called by XXX module  
     32   PUBLIC   trc_dia        ! called by XXX module  
     33   PUBLIC   trc_dia_alloc  ! called by nemogcm.F90 
    3534 
    3635   INTEGER  ::   nit5      !: id for tracer output file 
     
    4039   INTEGER  ::   ndimt51   !: number of ocean points in index array 
    4140   REAL(wp) ::   zjulian   !: ????   not DOCTOR ! 
    42    INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index 
    43    INTEGER , DIMENSION (jpij)    ::   ndext51   !: integer arrays for ocean surface index 
     41   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext50   !: integer arrays for ocean 3D index 
     42   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext51   !: integer arrays for ocean surface index 
    4443# if defined key_diatrc 
    4544   INTEGER  ::   nitd      !: id for additional array output file 
     
    5857   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5958   !! $Id$  
    60    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     59   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6160   !!---------------------------------------------------------------------- 
    6261CONTAINS 
     
    6867      !! ** Purpose :   output passive tracers fields  
    6968      !!--------------------------------------------------------------------- 
    70       INTEGER, INTENT( in ) :: kt 
    71       INTEGER               :: kindic 
     69      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
     70      ! 
     71      INTEGER ::   kindic   ! local integer 
    7272      !!--------------------------------------------------------------------- 
    7373      ! 
     
    9595      !!        IF kindic >0, output of fields before the time step loop 
    9696      !!---------------------------------------------------------------------- 
    97       INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    98       INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
    99       !! 
     97      INTEGER, INTENT(in) ::   kt       ! ocean time-step 
     98      INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination 
     99      ! 
    100100      INTEGER ::   jn 
    101101      LOGICAL ::   ll_print = .FALSE. 
     
    183183         DO jn = 1, jptra 
    184184            IF( lutsav(jn) ) THEN 
    185                cltra  = ctrcnm(jn)   ! short title for tracer 
    186                cltral = ctrcnl(jn)   ! long title for tracer 
    187                cltrau = ctrcun(jn)   ! UNIT for tracer 
     185               cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
     186               cltral = TRIM( ctrcnl(jn) )   ! long title for tracer 
     187               cltrau = TRIM( ctrcun(jn) )   ! UNIT for tracer 
    188188               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  & 
    189189                  &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout )  
     
    208208 
    209209      DO jn = 1, jptra 
    210          cltra = ctrcnm(jn)      ! short title for tracer 
     210         cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
    211211         IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
    212212      END DO 
     
    216216      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 ) 
    217217      ! 
    218  
    219218   END SUBROUTINE trcdit_wr 
    220219 
     
    237236      !!        IF kindic >0, output of fields before the time step loop 
    238237      !!---------------------------------------------------------------------- 
    239       INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    240       INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
     238      INTEGER, INTENT(in) ::   kt       ! ocean time-step 
     239      INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination 
    241240      !! 
    242241      LOGICAL ::   ll_print = .FALSE. 
     
    308307         ! more 3D horizontal arrays 
    309308         DO jl = 1, jpdia3d 
    310             cltra  = ctrc3d(jl)   ! short title for 3D diagnostic 
    311             cltral = ctrc3l(jl)   ! long title for 3D diagnostic 
    312             cltrau = ctrc3u(jl)   ! UNIT for 3D diagnostic 
     309            cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic 
     310            cltral = TRIM( ctrc3l(jl) )  ! long title for 3D diagnostic 
     311            cltrau = TRIM( ctrc3u(jl) )  ! UNIT for 3D diagnostic 
    313312            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   & 
    314313               &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout ) 
     
    317316         ! more 2D horizontal arrays 
    318317         DO jl = 1, jpdia2d 
    319             cltra  = ctrc2d(jl)    ! short title for 2D diagnostic 
    320             cltral = ctrc2l(jl)   ! long title for 2D diagnostic 
    321             cltrau = ctrc2u(jl)   ! UNIT for 2D diagnostic 
     318            cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic 
     319            cltral = TRIM( ctrc2l(jl) )  ! long title for 2D diagnostic 
     320            cltrau = TRIM( ctrc2u(jl) )  ! UNIT for 2D diagnostic 
    322321            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  & 
    323322               &          1, 1, 1,  -99, 32, clop, zsto, zout ) 
     
    345344      ! more 3D horizontal arrays 
    346345      DO jl = 1, jpdia3d 
    347          cltra = ctrc3d(jl)   ! short title for 3D diagnostic 
     346         cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic 
    348347         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50) 
    349348      END DO 
     
    351350      ! more 2D horizontal arrays 
    352351      DO jl = 1, jpdia2d 
    353          cltra = ctrc2d(jl)   ! short title for 2D diagnostic 
     352         cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic 
    354353         CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51) 
    355354      END DO 
     
    364363# else 
    365364   SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine 
    366       INTEGER, INTENT ( in ) :: kt, kindic 
     365      INTEGER, INTENT (in) :: kt, kindic 
    367366   END SUBROUTINE trcdii_wr 
    368367# endif 
     
    400399      ! Initialisation 
    401400      ! -------------- 
    402  
    403401       
    404402      ! local variable for debugging 
     
    451449         ! biological trends 
    452450         DO jl = 1, jpdiabio 
    453             cltra  = ctrbio(jl)   ! short title for biological diagnostic 
    454             cltral = ctrbil(jl)   ! long title for biological diagnostic 
    455             cltrau = ctrbiu(jl)   ! UNIT for biological diagnostic 
     451            cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic 
     452            cltral = TRIM( ctrbil(jl) )  ! long title for biological diagnostic 
     453            cltrau = TRIM( ctrbiu(jl) )  ! UNIT for biological diagnostic 
    456454            CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  & 
    457455               &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout) 
     
    477475 
    478476      DO jl = 1, jpdiabio 
    479          cltra = ctrbio(jl)  ! short title for biological diagnostic 
     477         cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic 
    480478         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50) 
    481479      END DO 
     
    485483      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb ) 
    486484      ! 
    487  
    488485   END SUBROUTINE trcdib_wr 
    489486 
     
    496493# endif  
    497494 
     495   INTEGER FUNCTION trc_dia_alloc() 
     496      !!--------------------------------------------------------------------- 
     497      !!                     ***  ROUTINE trc_dia_alloc  *** 
     498      !!--------------------------------------------------------------------- 
     499      ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=trc_dia_alloc ) 
     500      ! 
     501      IF( trc_dia_alloc /= 0 )   CALL ctl_warn('trc_dia_alloc : failed to allocate arrays') 
     502      ! 
     503   END FUNCTION trc_dia_alloc 
    498504#else 
    499505   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r2528 r2715  
    2323   PRIVATE 
    2424 
    25    PUBLIC trc_dta   ! called in trcini.F90 and trcdmp.F90 
     25   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90 
     26   PUBLIC   trc_dta_alloc   ! called in nemogcm.F90 
    2627 
    2728   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   trdta   !: tracer data at given time-step 
    29  
    30    REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) ::   tracdta            ! tracer data at two consecutive times 
    31    INTEGER , DIMENSION(jptra) ::   nlectr      !: switch for reading once 
    32    INTEGER , DIMENSION(jptra) ::   ntrc1       !: number of first month when reading 12 monthly value 
    33    INTEGER , DIMENSION(jptra) ::   ntrc2       !: number of second month when reading 12 monthly value 
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trdta   !: tracer data at given time-step 
     30 
     31   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   tracdta       ! tracer data at two consecutive times 
     32   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nlectr      !: switch for reading once 
     33   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of 1st month when reading 12 monthly value 
     34   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of 2nd month when reading 12 monthly value 
    3435 
    3536   !! * Substitutions 
     
    3839   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3940   !! $Id$  
    40    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4142   !!---------------------------------------------------------------------- 
    4243CONTAINS 
     
    5556      !!      two monthly values. 
    5657      !!---------------------------------------------------------------------- 
    57       INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
     58      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    5859      !! 
    5960      CHARACTER (len=39) ::   clname(jptra) 
     
    198199   END SUBROUTINE trc_dta 
    199200 
     201 
     202   INTEGER FUNCTION trc_dta_alloc() 
     203      !!---------------------------------------------------------------------- 
     204      !!                   ***  ROUTINE trc_dta_alloc  *** 
     205      !!---------------------------------------------------------------------- 
     206      ALLOCATE( trdta  (jpi,jpj,jpk,jptra  ) ,                    & 
     207         &      tracdta(jpi,jpj,jpk,jptra,2) ,                    & 
     208         &      nlectr(jptra) , ntrc1(jptra) , ntrc2(jptra) , STAT=trc_dta_alloc) 
     209         ! 
     210      IF( trc_dta_alloc /= 0 )   CALL ctl_warn('trc_dta_alloc : failed to allocate arrays') 
     211      ! 
     212   END FUNCTION trc_dta_alloc 
     213 
    200214#else 
    201215   !!---------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r2555 r2715  
    44   !! TOP :   Manage the passive tracer initialization 
    55   !!====================================================================== 
    6    !! History :    -   !  1991-03  ()  original code 
    7    !!             1.0  ! 2005-03 (O. Aumont, A. El Moussaoui) F90 
    8    !!              -   !  2005-10 (C. Ethe) print control 
    9    !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture 
     6   !! History :   -   ! 1991-03 (O. Marti)  original code 
     7   !!            1.0  ! 2005-03 (O. Aumont, A. El Moussaoui) F90 
     8   !!            2.0  ! 2005-10 (C. Ethe, G. Madec) revised architecture 
     9   !!            4.0  ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 
    1010   !!---------------------------------------------------------------------- 
    1111#if defined key_top 
     
    1313   !!   'key_top'                                                TOP models 
    1414   !!---------------------------------------------------------------------- 
    15    !!---------------------------------------------------------------------- 
    16    !!   trc_init :   Initialization for passive tracer 
     15   !!   trc_init  :   Initialization for passive tracer 
     16   !!   top_alloc :   allocate the TOP arrays 
    1717   !!---------------------------------------------------------------------- 
    1818   USE oce_trc 
     
    2626   USE trcini_my_trc   ! MY_TRC   initialisation 
    2727   USE trcdta    
    28 #if defined key_offline 
    2928   USE daymod 
    30 #endif 
    3129   USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    32    USE in_out_manager  ! I/O manager 
    3330   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    34    USE lib_mpp         ! distributed memory computing library 
    35    USE lib_fortran     !  
    3631    
    3732   IMPLICIT NONE 
     
    4237    !! * Substitutions 
    4338#  include "domzgr_substitute.h90" 
    44    
     39   !!---------------------------------------------------------------------- 
     40   !! NEMO/TOP 4.0 , NEMO Consortium (2011) 
     41   !! $Id$  
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     43   !!---------------------------------------------------------------------- 
    4544CONTAINS 
    4645    
     
    5958      INTEGER ::   jk, jn    ! dummy loop indices 
    6059      CHARACTER (len=25) :: charout 
    61  
    6260      !!--------------------------------------------------------------------- 
    6361 
     
    6664      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    6765 
    68       !                 ! masked grid volume 
     66      CALL top_alloc()              ! allocate TOP arrays 
     67 
     68      !                             ! masked grid volume 
    6969      DO jk = 1, jpk 
    7070         cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)  
    7171      END DO 
    7272 
    73       ! total volume of the ocean 
     73      !                             ! total volume of the ocean 
    7474#if ! defined key_degrad 
    7575      areatot = glob_sum( cvol(:,:,:) ) 
     
    7878#endif 
    7979 
    80                                   CALL trc_nam      ! read passive tracers namelists 
    81  
    82       ! restart for passive tracer (input) 
     80      CALL trc_nam                  ! read passive tracers namelists 
     81 
     82      !                             ! restart for passive tracer (input) 
    8383      IF( ln_rsttr ) THEN 
    8484         IF(lwp) WRITE(numout,*) '       read a restart file for passive tracer : ', cn_trcrst_in 
    8585         IF(lwp) WRITE(numout,*) ' ' 
    8686      ELSE 
    87          IF(lwp) WRITE(numout,*) 
    88          DO jn = 1, jptra 
    89             IF( lwp .AND. lutini(jn) )  &                  ! open input FILE only IF lutini(jn) is true 
    90             &  WRITE(numout,*) '        read an initial file  for passive tracer number :', jn, ' traceur : ', ctrcnm(jn)  
    91          END DO 
     87         IF( lwp .AND. lk_dtatrc ) THEN 
     88            DO jn = 1, jptra 
     89               IF( lutini(jn) )  &                  ! open input FILE only IF lutini(jn) is true 
     90                  &  WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' traceur : ', ctrcnm(jn)  
     91             END DO 
     92          ENDIF 
     93          IF( lwp ) WRITE(numout,*) 
    9294      ENDIF 
    9395 
     
    138140      ENDIF 
    139141  
    140       tra(:,:,:,:) = 0. 
     142      tra(:,:,:,:) = 0._wp 
    141143       
    142144      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    143       &                     CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    144  
    145  
    146       !                 ! Computation content of all tracers 
    147       trai = 0.e0 
     145        &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
     146 
     147 
     148      !            
     149      trai = 0._wp         ! Computation content of all tracers 
    148150      DO jn = 1, jptra 
    149151#if ! defined key_degrad 
     
    154156      END DO       
    155157 
    156       !                 ! control print 
    157       IF(lwp) WRITE(numout,*) 
    158       IF(lwp) WRITE(numout,*) 
    159       IF(lwp) WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    160       IF(lwp) WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    161       IF(lwp) WRITE(numout,*) '          *** Total inital content of all tracers  = ', trai 
    162       IF(lwp) WRITE(numout,*) 
    163  
    164       IF( ln_ctl )   CALL prt_ctl_trc_init      ! control print 
    165       ! 
    166  
    167       IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     158      IF(lwp) THEN               ! control print 
     159         WRITE(numout,*) 
     160         WRITE(numout,*) 
     161         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
     162         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
     163         WRITE(numout,*) '          *** Total inital content of all tracers  = ', trai 
     164         WRITE(numout,*) 
     165      ENDIF 
     166 
     167      IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
     168         CALL prt_ctl_trc_init 
    168169         WRITE(charout, FMT="('ini ')") 
    169170         CALL prt_ctl_trc_info( charout ) 
    170171         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    171172      ENDIF 
    172  
     173      ! 
    173174   END SUBROUTINE trc_init 
     175 
     176 
     177   SUBROUTINE top_alloc 
     178      !!---------------------------------------------------------------------- 
     179      !!                     ***  ROUTINE top_alloc  *** 
     180      !! 
     181      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
     182      !!---------------------------------------------------------------------- 
     183      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines... 
     184      USE trc           , ONLY:   trc_alloc 
     185      USE trcnxt        , ONLY:   trc_nxt_alloc 
     186      USE trczdf        , ONLY:   trc_zdf_alloc 
     187      USE trdmod_trc_oce, ONLY:   trd_mod_trc_oce_alloc 
     188#if ! defined key_iomput 
     189      USE trcdia        , ONLY:   trc_dia_alloc 
     190#endif 
     191#if defined key_trcdmp  
     192      USE trcdmp        , ONLY:   trc_dmp_alloc 
     193#endif 
     194#if defined key_dtatrc 
     195      USE trcdta        , ONLY:   trc_dta_alloc 
     196#endif 
     197#if defined key_trdmld_trc   ||   defined key_esopa 
     198      USE trdmld_trc    , ONLY:   trd_mld_trc_alloc 
     199#endif 
     200      ! 
     201      INTEGER :: ierr 
     202      !!---------------------------------------------------------------------- 
     203      ! 
     204      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines... 
     205      ierr = ierr + trc_alloc    () 
     206      ierr = ierr + trc_nxt_alloc() 
     207      ierr = ierr + trc_zdf_alloc() 
     208      ierr = ierr + trd_mod_trc_oce_alloc() 
     209#if ! defined key_iomput 
     210      ierr = ierr + trc_dia_alloc() 
     211#endif 
     212#if defined key_trcdmp  
     213      ierr = ierr + trc_dmp_alloc() 
     214#endif 
     215#if defined key_dtatrc 
     216      ierr = ierr + trc_dta_alloc() 
     217#endif 
     218#if defined key_trdmld_trc   ||   defined key_esopa 
     219      ierr = ierr + trd_mld_trc_alloc() 
     220#endif 
     221      ! 
     222      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     223      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' ) 
     224      ! 
     225   END SUBROUTINE top_alloc 
    174226 
    175227#else 
     
    182234#endif 
    183235 
    184    !!---------------------------------------------------------------------- 
    185    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    186    !! $Id$  
    187    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    188236   !!====================================================================== 
    189237END MODULE trcini 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r2528 r2715  
    2626   USE trcnam_c14b       ! C14 SMS namelist 
    2727   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    28    USE in_out_manager    ! I/O manager 
    2928   USE trdmod_trc_oce 
    3029 
     
    103102 
    104103      DO jn = 1, jptra 
    105          ctrcnm(jn) = sn_tracer(jn)%clsname 
    106          ctrcnl(jn) = sn_tracer(jn)%cllname 
    107          ctrcun(jn) = sn_tracer(jn)%clunit 
    108          lutini(jn) = sn_tracer(jn)%llinit 
    109          lutsav(jn) = sn_tracer(jn)%llsave 
     104         ctrcnm(jn) = TRIM( sn_tracer(jn)%clsname ) 
     105         ctrcnl(jn) = TRIM( sn_tracer(jn)%cllname ) 
     106         ctrcun(jn) = TRIM( sn_tracer(jn)%clunit  ) 
     107         lutini(jn) =       sn_tracer(jn)%llinit  
     108         lutsav(jn) =       sn_tracer(jn)%llsave 
    110109      END DO 
    111110 
     
    121120         DO jn = 1, jptra 
    122121            WRITE(numout,*) '   tracer nb             : ', jn  
    123             WRITE(numout,*) '   short name            : ', TRIM(ctrcnm(jn)) 
    124             WRITE(numout,*) '   long name             : ', TRIM(ctrcnl(jn)) 
    125             WRITE(numout,*) '   unit                  : ', TRIM(ctrcun(jn)) 
     122            WRITE(numout,*) '   short name            : ', ctrcnm(jn) 
     123            WRITE(numout,*) '   long name             : ', ctrcnl(jn) 
     124            WRITE(numout,*) '   unit                  : ', ctrcun(jn) 
    126125            WRITE(numout,*) '   initial value in FILE : ', lutini(jn)  
    127126            WRITE(numout,*) ' ' 
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r2528 r2715  
    2626   USE trc 
    2727   USE trcnam_trp 
    28    USE lib_mpp 
    29    USE lib_fortran 
    3028   USE iom 
    3129   USE trcrst_cfc      ! CFC       
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r2528 r2715  
    3030   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3131   !! $Id$  
    32    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
    34  
    3534CONTAINS 
    3635 
Note: See TracChangeset for help on using the changeset viewer.