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 2690 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2011-03-15T16:27:46+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; homogeneization of the coding style associated with dyn allocation

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC
Files:
28 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90

    r2528 r2690  
    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 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2643 r2690  
    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 
    … …  
    2323   PUBLIC   trc_ini_c14b   ! called by trcini.F90 module 
    2424 
    25    INTEGER  ::   &     ! With respect to data file !! 
    26      jpybeg = 1765 , & !: starting year for C14 
    27      jpyend = 2002     !: ending year for C14 
    28  
    29    INTEGER  ::   &    
    30       nrec   ,  & ! number of year in CO2 Concentrations file 
    31       nmaxrec  
    32  
    33    INTEGER  ::   inum1, inum2               ! unit number 
    34  
    35    REAL(wp) ::     & 
    36      ys40 = -40. ,    &             ! 40 degrees south 
    37      ys20 = -20. ,    &             ! 20 degrees south 
    38      yn20 =  20. ,    &             ! 20 degrees north 
    39      yn40 =  40.                    ! 40 degrees north 
    40  
    41    !!--------------------------------------------------------------------- 
     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   !!---------------------------------------------------------------------- 
    4238   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4339   !! $Id$  
    44    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    45    !!---------------------------------------------------------------------- 
    46  
     40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     41   !!---------------------------------------------------------------------- 
    4742CONTAINS 
    4843 
    … …  
    5853      !!---------------------------------------------------------------------- 
    5954 
    60       CALL c14b_alloc()       ! Allocate CFC arrays 
     55      !                     ! Allocate C14b arrays 
     56      IF( trc_sms_c14b_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' ) 
    6157 
    6258      CALL trc_ctl_c14b     !  Control consitency 
    … …  
    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 
    166161 
    167    SUBROUTINE c14b_alloc 
    168       !!---------------------------------------------------------------------- 
    169       !!                     ***  ROUTINE c14b_alloc  *** 
    170       !! 
    171       !! ** Purpose :   Allocate all the dynamic arrays of C14b 
    172       !!---------------------------------------------------------------------- 
    173  
    174       !                                ! Allocate C14b arrays 
    175       IF( trc_sms_c14b_alloc() /= 0 )   & 
    176          &         CALL ctl_stop( 'STOP', 'trc_ini_c14b : unable to allocate C14b arrays' ) 
    177       ! 
    178    END SUBROUTINE c14b_alloc 
    179     
     162 
    180163   SUBROUTINE trc_ctl_c14b 
    181164      !!---------------------------------------------------------------------- 
    … …  
    192175      ! Check number of tracers 
    193176      ! -----------------------    
    194       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' ) 
    195178 
    196179      ! Check tracer names 
    197180      ! ------------------ 
    198       IF ( ctrcnm(jpc14) /= 'C14B' ) THEN 
    199            ctrcnm(jpc14)  = 'C14B' 
    200            ctrcnl(jpc14)  = 'Bomb C14 concentration' 
     181      IF( ctrcnm(jpc14) /= 'C14B' ) THEN 
     182          ctrcnm(jpc14)  = 'C14B' 
     183          ctrcnl(jpc14)  = 'Bomb C14 concentration' 
    201184      ENDIF 
    202185 
    … …  
    210193      ! ------------------ 
    211194      IF( ctrcun(jpc14) /= 'ration' ) THEN 
    212           ctrcun(jpc14) = 'ration' 
     195          ctrcun(jpc14)  = 'ration' 
    213196          IF(lwp) THEN 
    214197             CALL ctl_warn( ' we force tracer unit' ) 
    … …  
    219202      ! 
    220203   END SUBROUTINE trc_ctl_c14b 
     204    
    221205#else 
    222206   !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2643 r2690  
    1313   !!   'key_c14b'                                         Bomb C14 tracer 
    1414   !!---------------------------------------------------------------------- 
    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 
     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 
    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    !! * Routine accessibility 
    2827   PUBLIC   trc_sms_c14b       ! called in trcsms.F90 
    29    PUBLIC   trc_sms_c14b_alloc ! called in nemogcm.F90 
    30  
    31    !! * Module variables 
     28   PUBLIC   trc_sms_c14b_alloc ! called in trcini_c14b.F90 
     29 
    3230   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec  = 240           ! temporal parameter  
    3331   INTEGER , PUBLIC, PARAMETER ::   jpmaxrec2 = 2 * jpmaxrec  !  
    … …  
    3937   INTEGER , PUBLIC    ::   nyear_beg        ! initial year (aa)  
    4038 
    41    REAL(wp), PUBLIC,           DIMENSION(jpmaxrec,jpzon)  ::  bomb   !: C14 atm data (3 zones) 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::  fareaz !: Spatial Interpolation Factors 
    43    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 
    4442   
    45    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   qtr_c14      !: flux at surface 
    46    REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   qint_c14     !: cumulative flux 
    47  
    48    REAL(wp) :: xlambda, xdecay, xaccum       ! C14 decay coef.   
    49  
    50    REAL(wp) ::   xconv1 = 1.0          ! conversion from to  
    51    REAL(wp) ::   xconv2 = 0.01/3600.   ! conversion from cm/h to m/s:  
    52    REAL(wp) ::   xconv3 = 1.0e+3       ! conversion from mol/l/atm to mol/m3/atm 
    53  
    54   !! * 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 
    5552#  include "top_substitute.h90" 
    5653 
    57   !!---------------------------------------------------------------------- 
    58   !!  TOP 1.0 , LOCEAN-IPSL (2005)  
    59   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp $  
    60   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    61   !!---------------------------------------------------------------------- 
    62  
     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   !!---------------------------------------------------------------------- 
    6359CONTAINS 
    6460 
    65  
    66   SUBROUTINE trc_sms_c14b( kt ) 
    67      !!---------------------------------------------------------------------- 
    68      !!                  ***  ROUTINE trc_sms_c14b  *** 
    69      !! 
    70      !! ** Purpose :   Compute the surface boundary contition on C14bomb 
    71      !!      passive tracer associated with air-mer fluxes and add it to  
    72      !!      the general trend of tracers equations. 
    73      !! 
    74      !! ** Original comments from J. Orr : 
    75      !! 
    76      !!      Calculates the input of Bomb C-14 to the surface layer of OPA 
    77      !! 
    78      !!      James Orr, LMCE, 28 October 1992 
    79      !! 
    80      !!      Initial approach mimics that of Toggweiler, Dixon, & Bryan (1989) 
    81      !!      (hereafter referred to as TDB) with constant gas exchange, 
    82      !!      although in this case, a perturbation approach is used for 
    83      !!      bomb-C14 so that both the ocean and atmosphere begin at zero. 
    84      !!      This saves tremendous amounts of computer time since no 
    85      !!      equilibrum run is first required (i.e., for natural C-14). 
    86      !!      Note: Many sensitivity tests can be run with this approach and 
    87      !!            one never has to make a run for natural C-14; otherwise, 
    88      !!            a run for natural C-14 must be run each time that one 
    89      !!            changes a model parameter! 
    90      !! 
    91      !! 
    92      !!      19 August 1993: Modified to consider Atmospheric C-14 fom IPCC. 
    93      !!      That is, the IPCC has provided a C-14 atmospheric record (courtesy 
    94      !!      of Martin Heimann) for model calibration.  This model spans from 
    95      !!      preindustrial times to present, in a format different than that 
    96      !!      given by TDB.  It must be converted to the ORR C-14 units used 
    97      !!      here, although in this case, the perturbation includes not only 
    98      !!      bomb C-14 but changes due to the Suess effect. 
    99      !! 
    100      !!---------------------------------------------------------------------- 
    101      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    102      USE wrk_nemo, ONLY: zatmbc14 => wrk_2d_1 
    103      USE wrk_nemo, ONLY:     zw3d => wrk_3d_1 
    104      !! * Arguments 
    105      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    106  
    107      !! * Local declarations 
    108      INTEGER :: ji, jj, jk, jz     ! dummy loop indices  
    109  
    110      INTEGER :: iyear_beg, iyear_beg1, iyear_end1  
    111      INTEGER :: iyear_beg2, iyear_end2  
    112      INTEGER :: imonth1, im1, in1  
    113      INTEGER :: imonth2, im2, in2  
    114           
    115      REAL(wp), DIMENSION(jpzon) :: zonbc14       !: time interp atm C14  
    116      REAL(wp)                   :: zpco2at       !: time interp atm C02  
    117  
    118      REAL(wp) :: zt, ztp, zsk      !: dummy variables 
    119      REAL(wp) :: zsol              !: solubility 
    120      REAL(wp) :: zsch              !: schmidt number 
    121      REAL(wp) :: zv2               !: wind speed ( square) 
    122      REAL(wp) :: zpv               !: piston velocity  
    123      REAL(wp) :: zdemi, ztra 
    124       !!---------------------------------------------------------------------- 
    125  
    126       IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 1) ) ) THEN 
    127          CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable.') 
    128          RETURN 
    129       END IF 
    130  
    131       IF( kt == nit000 )  THEN 
    132          ! Computation of decay coeffcient 
    133          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 
    134123         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) 
    135124         xdecay  = EXP( - xlambda * rdt ) 
    136          xaccum  = 1.0 -  xdecay 
     125         xaccum  = 1._wp -  xdecay 
    137126      ENDIF 
    138127 
    … …  
    204193      !  (zonmean), computes area-weighted mean to give the atmospheric C-14 
    205194      !  ---------------------------------------------------------------- 
    206       DO jj = 1, jpj 
    207          DO ji = 1, jpi 
    208             zatmbc14(ji,jj) =   zonbc14(1) * fareaz(ji,jj,1)  & 
    209                  &           +  zonbc14(2) * fareaz(ji,jj,2)  & 
    210                  &           +  zonbc14(3) * fareaz(ji,jj,3) 
    211          END DO 
    212       END DO 
     195      zatmbc14(:,:) = zonbc14(1) * fareaz(:,:,1)   & 
     196         &          + zonbc14(2) * fareaz(:,:,2)   & 
     197         &          + zonbc14(3) * fareaz(:,:,3) 
    213198       
    214199      ! time interpolation of CO2 concentrations to it time step   
    … …  
    216201           &     + spco2(iyear_end2) * FLOAT( in2 ) ) / 6. 
    217202 
    218       IF (lwp) THEN 
     203      IF(lwp) THEN 
    219204          WRITE(numout, *) 'time : ', kt, ' CO2 year begin/end :',iyear_beg2,'/',iyear_end2,   & 
    220205          &                ' CO2 concen : ',zpco2at  
    … …  
    236221               zsol = EXP( -60.2409 + 93.4517 / ztp  + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 
    237222               ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)] 
    238                zsol = zsol * 1.0e-03 
     223               zsol = zsol * 1.e-03 
    239224            ELSE 
    240                zsol = 0. 
     225               zsol = 0._wp 
    241226            ENDIF 
    242227 
    … …  
    305290      CALL iom_put( "fdecay" , zw3d ) 
    306291#endif 
    307       IF( l_trdtrc ) THEN 
    308          CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
    309       END IF 
    310  
    311       IF( ( wrk_not_released(2, 1)) .OR. ( wrk_not_released(3, 1) ) )   & 
    312       &   CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays.') 
    313  
    314     END SUBROUTINE trc_sms_c14b 
    315  
    316   INTEGER FUNCTION trc_sms_c14b_alloc() 
    317      !!---------------------------------------------------------------------- 
    318      !!                  ***  ROUTINE trc_sms_c14b_alloc  *** 
    319      !!---------------------------------------------------------------------- 
    320  
    321      ALLOCATE( fareaz(jpi,jpj ,jpzon),     & 
    322        &       qtr_c14(jpi,jpj)      ,     & 
    323        &       qint_c14(jpi,jpj)     , STAT=trc_sms_c14b_alloc ) 
    324  
    325      IF( trc_sms_c14b_alloc /= 0 ) CALL ctl_warn('trc_sms_c14b_alloc : failed to allocate arrays.') 
    326  
    327   END FUNCTION trc_sms_c14b_alloc 
     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 
     311 
    328312#else 
    329     !!---------------------------------------------------------------------- 
    330     !!   Default option                                         Dummy module 
    331     !!---------------------------------------------------------------------- 
     313   !!---------------------------------------------------------------------- 
     314   !!   Default option                                         Dummy module 
     315   !!---------------------------------------------------------------------- 
    332316CONTAINS 
    333   SUBROUTINE trc_sms_c14b( kt )       ! Empty routine 
    334     WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt 
    335   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 
    336320#endif 
    337321 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r2643 r2690  
    3333   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3434   !!---------------------------------------------------------------------- 
    35  
    3635CONTAINS 
    3736 
    … …  
    4544      !!---------------------------------------------------------------------- 
    4645      INTEGER  ::  ji, jj, jn, jl, jm, js 
    47       REAL(wp) ::  zyy  , zyd 
     46      REAL(wp) ::  zyy, zyd 
    4847      !!---------------------------------------------------------------------- 
    4948 
    … …  
    5251      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    5352 
    54       CALL cfc_alloc()       ! Allocate CFC arrays 
     53      !                                ! Allocate CFC arrays 
     54      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' ) 
    5555 
    5656 
    5757      ! Initialization of boundaries conditions 
    5858      ! ---------------------------------------  
    59       xphem (:,:)    = 0.e0 
    60       p_cfc(:,:,:)   = 0.e0 
     59      xphem (:,:)    = 0._wp 
     60      p_cfc(:,:,:)   = 0._wp 
    6161       
    6262      ! Initialization of qint in case of  no restart  
    6363      !---------------------------------------------- 
    64       qtr_cfc(:,:,:) = 0.e0 
     64      qtr_cfc(:,:,:) = 0._wp 
    6565      IF( .NOT. ln_rsttr ) THEN     
    6666         IF(lwp) THEN 
    … …  
    6868            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
    6969         ENDIF 
    70          qint_cfc(:,:,:) = 0.e0 
     70         qint_cfc(:,:,:) = 0._wp 
    7171         DO jl = 1, jp_cfc 
    7272            jn = jp_cfc0 + jl - 1 
    73             trn     (:,:,:,jn) = 0.e0 
     73            trn(:,:,:,jn) = 0._wp 
    7474         END DO 
    7575      ENDIF 
    … …  
    117117         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
    118118         DO jn = 30, 100 
    119             WRITE(numout, '( 1I4, 4F9.2)')   & 
    120                &         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) 
    121120         END DO 
    122121      ENDIF 
    … …  
    136135      END DO 
    137136      ! 
    138  
    139137      IF(lwp) WRITE(numout,*) 'Initialization of CFC tracers done' 
    140138      IF(lwp) WRITE(numout,*) ' ' 
    141  
     139      ! 
    142140   END SUBROUTINE trc_ini_cfc 
    143  
    144    SUBROUTINE cfc_alloc 
    145       !!---------------------------------------------------------------------- 
    146       !!                     ***  ROUTINE cfc_alloc  *** 
    147       !! 
    148       !! ** Purpose :   Allocate all the dynamic arrays of CFC 
    149       !!---------------------------------------------------------------------- 
    150  
    151       !                                ! Allocate CFC arrays 
    152       IF( trc_sms_cfc_alloc() /= 0 )   & 
    153          &           CALL ctl_stop( 'STOP', 'trc_ini_cfc : unable to allocate CFC arrays' ) 
    154       ! 
    155    END SUBROUTINE cfc_alloc 
    156141    
    157142#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2643 r2690  
    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 
    … …  
    2626 
    2727   PUBLIC   trc_sms_cfc         ! called in ???     
    28    PUBLIC   trc_sms_cfc_alloc   ! called in nemogcm.F90 
     28   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90 
    2929 
    3030   INTEGER , PUBLIC, PARAMETER ::   jpyear = 150   ! temporal parameter  
    … …  
    5555   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5656   !! $Id$  
    57    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    58    !!---------------------------------------------------------------------- 
    59  
     57   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     58   !!---------------------------------------------------------------------- 
    6059CONTAINS 
    61  
    6260 
    6361   SUBROUTINE trc_sms_cfc( kt ) 
    … …  
    7775      !!                CFC concentration in pico-mol/m3 
    7876      !!---------------------------------------------------------------------- 
    79       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY: ztrcfc => wrk_3d_1        ! use for CFC sms trend 
    81       !! 
    82       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    83       !! 
    84       INTEGER ::   ji, jj, jn, jl, jm, js 
    85       INTEGER ::   iyear_beg, iyear_end 
    86       INTEGER ::   im1, im2 
    87  
     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 
    8885      REAL(wp) ::   ztap, zdtap         
    8986      REAL(wp) ::   zt1, zt2, zt3, zv2 
    … …  
    9390      REAL(wp) ::   zca_cfc   ! concentration at equilibrium 
    9491      REAL(wp) ::   zak_cfc   ! transfert coefficients 
    95  
    96       REAL(wp), DIMENSION(jphem,jp_cfc)   ::   zpatm       ! atmospheric function 
    97       !!---------------------------------------------------------------------- 
    98  
     92      REAL(wp), DIMENSION(jphem,jp_cfc) ::   zpatm   ! atmospheric function 
     93      !!---------------------------------------------------------------------- 
     94      ! 
    9995      IF( wrk_in_use(3, 1) ) THEN 
    100          CALL ctl_stop('trc_sms_cfc : requested workspace array unavailable.') 
    101          RETURN 
    102       END IF 
     96         CALL ctl_stop('trc_sms_cfc: requested workspace array unavailable')   ;   RETURN 
     97      ENDIF 
    10398 
    10499      IF( kt == nit000 )   CALL trc_cfc_cst 
    … …  
    199194          END DO 
    200195      END IF 
    201  
    202       IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_cfc : failed to release workspace array.') 
    203  
     196      ! 
     197      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_cfc: failed to release workspace array') 
     198      ! 
    204199   END SUBROUTINE trc_sms_cfc 
     200 
    205201 
    206202   SUBROUTINE trc_cfc_cst 
    … …  
    211207      !!--------------------------------------------------------------------- 
    212208 
    213  
    214         ! coefficient for CFC11  
    215         !---------------------- 
    216  
    217         ! Solubility 
    218         soa(1,1) = -229.9261  
    219         soa(2,1) =  319.6552 
    220         soa(3,1) =  119.4471 
    221         soa(4,1) =  -1.39165 
    222  
    223         sob(1,1) =  -0.142382 
    224         sob(2,1) =   0.091459 
    225         sob(3,1) =  -0.0157274 
    226  
    227         ! Schmidt number  
    228         sca(1,1) = 3501.8 
    229         sca(2,1) = -210.31 
    230         sca(3,1) =  6.1851 
    231         sca(4,1) = -0.07513 
    232  
    233         ! coefficient for CFC12  
    234         !---------------------- 
    235  
    236         ! Solubility 
    237         soa(1,2) = -218.0971 
    238         soa(2,2) =  298.9702 
    239         soa(3,2) =  113.8049 
    240         soa(4,2) =  -1.39165 
    241  
    242         sob(1,2) =  -0.143566 
    243         sob(2,2) =   0.091015 
    244         sob(3,2) =  -0.0153924 
    245  
    246         ! schmidt number  
    247         sca(1,2) =  3845.4  
    248         sca(2,2) =  -228.95 
    249         sca(3,2) =  6.1908  
    250         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 
    251246 
    252247   END SUBROUTINE trc_cfc_cst 
    253     
     248 
     249 
    254250   INTEGER FUNCTION trc_sms_cfc_alloc() 
    255251      !!---------------------------------------------------------------------- 
    256252      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
    257253      !!---------------------------------------------------------------------- 
    258  
    259       ALLOCATE( xphem(jpi,jpj)          ,    & 
    260          &      qtr_cfc(jpi,jpj,jp_cfc) ,    & 
    261          &      qint_cfc(jpi,jpj,jp_cfc),    & 
    262          &                               STAT=trc_sms_cfc_alloc ) 
    263  
     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         ! 
    264258      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
    265  
     259      ! 
    266260   END FUNCTION trc_sms_cfc_alloc 
    267261 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/sms_lobster.F90

    r2643 r2690  
    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   !!---------------------------------------------------------------------- 
    1313#if defined key_lobster 
    … …  
    1515   !!   'key_lobster'                                         LOBSTER model 
    1616   !!---------------------------------------------------------------------- 
    17    USE par_oce 
    18    USE par_trc 
     17   USE par_oce    ! ocean parameters 
     18   USE par_trc    ! passive tracer parameters 
     19   USE lib_mpp    ! MPP library 
    1920 
    2021   IMPLICIT NONE 
    2122   PUBLIC 
     23 
     24   PUBLIC   sms_lobster_alloc   ! called in trcini_lobster.F90 
    2225 
    2326   !!  biological parameters 
    … …  
    7376   !! Optical parameters                                 
    7477   !! ------------------                                 
    75    REAL(wp) ::   xkr0       !: water coefficient absorption in red      (NAMELIST) 
    76    REAL(wp) ::   xkg0       !: water coefficient absorption in green    (NAMELIST) 
    77    REAL(wp) ::   xkrp       !: pigment coefficient absorption in red    (NAMELIST) 
    78    REAL(wp) ::   xkgp       !: pigment coefficient absorption in green  (NAMELIST) 
    79    REAL(wp) ::   xlr        !: exposant for pigment absorption in red   (NAMELIST) 
    80    REAL(wp) ::   xlg        !: exposant for pigment absorption in green (NAMELIST) 
    81    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) 
    8285                                                         
    83    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   neln    !: number of levels in the euphotic layer 
    84    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   xze     !: euphotic layer depth 
    85    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:,:) ::   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) 
    8689 
    8790   !! Sediment parameters                                
    … …  
    9194   REAL(wp) ::   areacot      !: ??? 
    9295                                                         
    93    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:)   ::   dminl   !: fraction of sinking POC released in sediments 
    94    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:,:) ::   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 
    9598                                                         
    96    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   sedpocb     !: mass of POC in sediments 
    97    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   sedpocn     !: mass of POC in sediments 
    98    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   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 
    99102                                                         
    100    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   fbod        !: rapid sinking particles 
    101    REAL(wp), ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   cmask       !: ??? 
     103   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fbod      !: rapid sinking particles 
     104   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   cmask     !: ??? 
    102105 
    103106   !!---------------------------------------------------------------------- 
    104107   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    105108   !! $Id$  
    106    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     109   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    107110   !!---------------------------------------------------------------------- 
    108111CONTAINS 
    … …  
    112115      !!        *** ROUTINE sms_lobster_alloc *** 
    113116      !!---------------------------------------------------------------------- 
    114       USE lib_mpp, ONLY:   ctl_warn   ! MPP library 
    115       INTEGER :: ierr(3)        ! Local variables 
    116       !!---------------------------------------------------------------------- 
    117  
    118       ierr(:) = 0 
    119       !*  Biological parameters 
    120       ALLOCATE( remdmp(jpk,jp_lobster),                               STAT=ierr(1) ) 
    121  
    122       !*  Optical parameters 
    123       ALLOCATE( neln(jpi,jpj)     , xze(jpi,jpj),                         & 
    124         &       xpar(jpi,jpj,jpk) ,                                   STAT=ierr(2) ) 
    125  
    126       !*  Sediment parameters 
    127       ALLOCATE( dminl(jpi,jpj)  , dmin3(jpi,jpj,jpk),                     & 
    128         &       sedpocb(jpi,jpj), sedpocn(jpi,jpj)  , sedpoca(jpi,jpj),   & 
    129         &       fbod(jpi,jpj)   , cmask(jpi,jpj)    ,                 STAT=ierr(3) )  
    130  
    131       sms_lobster_alloc = MAXVAL( ierr ) 
    132    
    133       IF( sms_lobster_alloc /= 0 ) CALL ctl_warn('sms_lobster_alloc : failed to allocate arrays.') 
    134  
     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      ! 
    135131   END FUNCTION sms_lobster_alloc 
    136132 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r2643 r2690  
    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 
    … …  
    3131   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3232   !! $Id$  
    33    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    34    !!---------------------------------------------------------------------- 
    35  
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     34   !!---------------------------------------------------------------------- 
    3635CONTAINS 
    3736 
    … …  
    4140      !! ** purpose :   specific initialisation for LOBSTER bio-model 
    4241      !!---------------------------------------------------------------------- 
    43       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    44       USE wrk_nemo, ONLY: zrro => wrk_2d_1, zdm0 => wrk_3d_1 
     42      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     43      USE wrk_nemo, ONLY:   zrro => wrk_2d_1 , zdm0 => wrk_3d_1 
    4544      !! 
    4645      INTEGER  ::   ji, jj, jk, jn 
    4746      REAL(wp) ::   ztest, zfluo, zfluu 
    4847      !!---------------------------------------------------------------------- 
     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 
    4952 
    5053      IF(lwp) WRITE(numout,*) 
    … …  
    5255      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
    5356 
    54  
    55       CALL lobster_alloc()       ! Allocate LOBSTER arrays 
    56  
    57       IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 1) ) )  THEN 
    58          CALL ctl_stop('trc_ini_lobster : requested workspace arrays unavailable.')   ;  RETURN 
    59       ENDIF 
     57      !                                ! Allocate LOBSTER arrays 
     58      IF( sms_lobster_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_lobster: unable to allocate LOBSTER arrays' ) 
     59 
    6060 
    6161 
    6262      ! initialization of fields for optical model 
    6363      ! -------------------------------------------- 
    64       xze (:,:)   = 5.e0 
    65       xpar(:,:,:) = 0.e0 
     64      xze (:,:)   = 5._wp 
     65      xpar(:,:,:) = 0._wp 
    6666 
    6767      ! initialization for passive tracer remineralisation-damping  array 
    … …  
    7373 
    7474      IF(lwp) THEN 
    75          WRITE(numout,*) ' ' 
    76          WRITE(numout,*) ' trcini: compute remineralisation-damping  ' 
    77          WRITE(numout,*) '         arrays for tracers' 
     75         WRITE(numout,*) 
     76         WRITE(numout,*) ' trcini: compute remineralisation-damping arrays for tracers' 
    7877      ENDIF 
    7978 
    … …  
    8584      ! ------------------------------------------------------------ 
    8685 
    87       zdm0   = 0.e0 
    88       zrro = 1.e0 
    89       DO jk = jpkb,jpkm1 
    90          DO jj =1, jpj 
    91             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 
    9291               zfluo = ( fsdepw(ji,jj,jk  ) / fsdepw(ji,jj,jpkb) )**xhr  
    9392               zfluu = ( fsdepw(ji,jj,jk+1) / fsdepw(ji,jj,jpkb) )**xhr 
    94                IF( zfluo.GT.1. )   zfluo = 1.e0 
     93               IF( zfluo.GT.1. )   zfluo = 1._wp 
    9594               zdm0(ji,jj,jk) = zfluo - zfluu 
    96                IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0.e0 
     95               IF( jk <= jpkb-1 )   zdm0(ji,jj,jk) = 0._wp 
    9796               zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 
    9897            END DO 
    9998         END DO 
    10099      END DO 
    101  
     100      ! 
    102101      zdm0(:,:,jpk) = zrro(:,:) 
    103102 
    … …  
    106105      ! contains total fraction, which has passed to the upper layers) 
    107106      ! ---------------------------------------------------------------------- 
    108       dminl = 0. 
    109       dmin3 = zdm0 
     107      dminl(:,:)   = 0._wp 
     108      dmin3(:,:,:) = zdm0 
    110109      DO jk = 1, jpk 
    111110         DO jj = 1, jpj 
    112111            DO ji = 1, jpi 
    113                IF( tmask(ji,jj,jk) == 0. ) THEN 
     112               IF( tmask(ji,jj,jk) == 0._wp ) THEN 
    114113                  dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 
    115                   dmin3(ji,jj,jk) = 0.e0 
     114                  dmin3(ji,jj,jk) = 0._wp 
    116115               ENDIF 
    117116            END DO 
    … …  
    121120      DO jj = 1, jpj 
    122121         DO ji = 1, jpi 
    123             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 
    124123         END DO 
    125124      END DO 
    … …  
    127126      ! Coastal mask  
    128127      ! ------------    
    129       cmask(:,:) = 0.e0 
     128      cmask(:,:) = 0._wp 
    130129      DO ji = 2, jpi-1 
    131130         DO jj = 2, jpj-1 
    132             if (tmask(ji,jj,1) == 1) then 
     131            IF( tmask(ji,jj,1) == 1._wp ) THEN 
    133132               ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) 
    134                IF (ztest == 0) cmask(ji,jj) = 1. 
    135             endif 
     133               IF( ztest == 0 )   cmask(ji,jj) = 1._wp 
     134            ENDIF 
    136135         END DO 
    137136      END DO 
    … …  
    249248 
    250249      !  initialize the POC in sediments 
    251       sedpocb(:,:) = 0.e0 
    252       sedpocn(:,:) = 0.e0 
    253       sedpoca(:,:) = 0.e0 
    254  
    255  
     250      sedpocb(:,:) = 0._wp 
     251      sedpocn(:,:) = 0._wp 
     252      sedpoca(:,:) = 0._wp 
     253      ! 
    256254      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 
    257       IF(lwp) WRITE(numout,*) ' ' 
    258  
    259       IF( ( wrk_not_released(2, 1) ) .OR. ( wrk_not_released(3, 1) ) )   & 
    260         &      CALL ctl_stop('trc_ini_lobster : failed to release workspace arrays.') 
    261  
     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      ! 
    262259   END SUBROUTINE trc_ini_lobster 
    263  
    264    SUBROUTINE lobster_alloc 
    265       !!---------------------------------------------------------------------- 
    266       !!                     ***  ROUTINE lobster_alloc  *** 
    267       !! 
    268       !! ** Purpose :   Allocate all the dynamic arrays of LOBSTER 
    269       !!---------------------------------------------------------------------- 
    270  
    271       !                                ! Allocate LOBSTER arrays 
    272       IF( sms_lobster_alloc() /= 0 )   & 
    273       &              CALL ctl_stop( 'STOP', 'trc_ini_lobster : unable to allocate LOBSTER arrays' ) 
    274       ! 
    275    END SUBROUTINE lobster_alloc 
    276260 
    277261#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r2643 r2690  
    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       CALL my_trc_alloc()     ! Allocate MY_TRC arrays 
     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' ) 
    4141 
    4242      CALL trc_ctl_my_trc     ! Control consitency 
    … …  
    4747       
    4848      IF( .NOT. ln_rsttr ) trn(:,:,:,jp_myt0:jp_myt1) = 0. 
    49  
    5049      ! 
    5150   END SUBROUTINE trc_ini_my_trc 
    52     
     51 
     52 
    5353   SUBROUTINE trc_ctl_my_trc 
    5454      !!---------------------------------------------------------------------- 
    … …  
    5757      !! ** Purpose :   control the cpp options, namelist and files  
    5858      !!---------------------------------------------------------------------- 
    59  
    6059      INTEGER :: jl, jn 
    61  
     60      !!---------------------------------------------------------------------- 
     61      ! 
    6262      IF(lwp) WRITE(numout,*) 
    6363      IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 
    64  
     64      ! 
    6565      DO jl = 1, jp_my_trc 
    6666         jn = jp_myt0 + jl - 1 
    … …  
    6969         ctrcun(jn)='N/A' 
    7070      END DO 
    71  
    72  
     71      ! 
    7372   END SUBROUTINE trc_ctl_my_trc 
    74  
    75    SUBROUTINE my_trc_alloc 
    76       !!---------------------------------------------------------------------- 
    77       !!                     ***  ROUTINE my_trc_alloc  *** 
    78       !! 
    79       !! ** Purpose :   Allocate all the dynamic arrays of MY_TRC 
    80       !!---------------------------------------------------------------------- 
    81  
    82       !                                ! Allocate MY_TRC arrays 
    83       ! 
    84    END SUBROUTINE my_trc_alloc 
    8573 
    8674#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r2528 r2690  
    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   !!---------------------------------------------------------------------- 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r2643 r2690  
    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    PUBLIC   p4z_che_alloc   
    28  
    29    !! * Shared module variables 
    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    !! * Module variables 
    35  
    36    REAL(wp) :: & 
    37       salchl = 1./1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    38  
    39    REAL(wp) :: &            ! coeff. for apparent solubility equilibrium  
    40       akcc1 = -171.9065 , &    ! Millero et al. 1995 from Mucci 1983 
    41       akcc2 = -0.077993 , &   
    42       akcc3 = 2839.319  , &   
    43       akcc4 = 71.595    , &   
    44       akcc5 = -0.77712  , &   
    45       akcc6 = 0.0028426 , &   
    46       akcc7 = 178.34    , &   
    47       akcc8 = -0.07711  , &   
    48       akcc9 = 0.0041249 
    49  
    50    REAL(wp) :: &             ! universal gas constants 
    51       rgas = 83.143, & 
    52       oxyco = 1./22.4144 
    53  
    54    REAL(wp) :: &             ! borat constants 
    55       bor1 = 0.00023, & 
    56       bor2 = 1./10.82 
    57  
    58    REAL(wp) :: &              ! 
    59       ca0 = -162.8301  , & 
    60       ca1 = 218.2968   , & 
    61       ca2 = 90.9241    , & 
    62       ca3 = -1.47696   , & 
    63       ca4 = 0.025695   , & 
    64       ca5 = -0.025225  , & 
    65       ca6 = 0.0049867 
    66  
    67    REAL(wp) :: &              ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
    68       c10 = -3670.7   , & 
    69       c11 = 62.008    , & 
    70       c12 = -9.7944   , & 
    71       c13 = 0.0118    , & 
    72       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 
    7365 
    7466   REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
    … …  
    132124      ox2 = 23.8439    , & 
    133125      ox3 = -0.034892  , & 
    134       ox4 = 0.015568   , & 
     126      ox4 =  0.015568  , & 
    135127      ox5 = -0.0019387  
    136128 
    … …  
    150142   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    151143   !! $Id$  
    152    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    153    !!---------------------------------------------------------------------- 
    154  
     144   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     145   !!---------------------------------------------------------------------- 
    155146CONTAINS 
    156  
    157147 
    158148   SUBROUTINE p4z_che 
    … …  
    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 
    326316   INTEGER FUNCTION p4z_che_alloc() 
    327317      !!---------------------------------------------------------------------- 
    328318      !!                     ***  ROUTINE p4z_che_alloc  *** 
    329319      !!---------------------------------------------------------------------- 
    330  
    331       ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk),  & 
    332         &       chemc(jpi,jpj,2),                     STAT=p4z_che_alloc ) 
    333  
    334       IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 
    335  
     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      ! 
    336324   END FUNCTION p4z_che_alloc 
     325 
    337326#else 
    338327   !!====================================================================== 
    … …  
    341330CONTAINS 
    342331   SUBROUTINE p4z_che( kt )                   ! Empty routine 
    343       INTEGER, INTENT( in ) ::   kt 
     332      INTEGER, INTENT(in) ::   kt 
    344333      WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 
    345334   END SUBROUTINE p4z_che 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r2644 r2690  
    3838   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
    3939 
    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  
     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       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: zkgco2 => wrk_2d_1, zkgo2 => wrk_2d_2, zh2co3 => wrk_2d_3  
    67       USE wrk_nemo, ONLY: zoflx  => wrk_2d_4, zkg   => wrk_2d_5 
    68       USE wrk_nemo, ONLY: zdpco2 => wrk_2d_6, zdpo2 => wrk_2d_7 
    69       ! 
    70       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      ! 
    7171      INTEGER  ::   ji, jj, jrorr 
    7272      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan 
    … …  
    7474      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
    7575      CHARACTER (len=25) :: charout 
    76  
    7776      !!--------------------------------------------------------------------- 
    7877 
    7978      IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 
    80          CALL ctl_stop('p4z_flx: requested workspace arrays unavailable') ; RETURN 
    81       END IF 
     79         CALL ctl_stop('p4z_flx: requested workspace arrays unavailable')   ;  RETURN 
     80      ENDIF 
    8281 
    8382      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    … …  
    213212      CALL iom_put( "Dpo2" , zdpo2  ) 
    214213#endif 
    215  
    216       IF( wrk_not_released(2, 1,2,3,4,5,6,7) ) CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
     214      ! 
     215      IF( wrk_not_released(2, 1,2,3,4,5,6,7) )   CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
    217216      ! 
    218217   END SUBROUTINE p4z_flx 
    219218 
     219 
    220220   SUBROUTINE p4z_flx_init 
    221  
    222221      !!---------------------------------------------------------------------- 
    223222      !!                  ***  ROUTINE p4z_flx_init  *** 
    … …  
    228227      !!      called at the first timestep (nit000) 
    229228      !! ** input   :   Namelist nampisext 
    230       !! 
    231       !!---------------------------------------------------------------------- 
    232  
     229      !!---------------------------------------------------------------------- 
    233230      NAMELIST/nampisext/ atcco2 
    234  
     231      !!---------------------------------------------------------------------- 
     232      ! 
    235233      REWIND( numnat )                     ! read numnat 
    236234      READ  ( numnat, nampisext ) 
    237  
     235      ! 
    238236      IF(lwp) THEN                         ! control print 
    239237         WRITE(numout,*) ' ' 
    … …  
    242240         WRITE(numout,*) '    Atmospheric pCO2      atcco2      =', atcco2 
    243241      ENDIF 
    244  
    245       ! interior global domain surface 
    246       area = glob_sum( e1e2t(:,:) )   
    247  
    248       ! Initialization of Flux of Carbon 
    249       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 
    250246      t_atm_co2_flx = 0._wp 
    251       ! Initialisation of atmospheric pco2 
    252       satmco2(:,:)  = atcco2 
     247      ! 
     248      satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    253249      t_oce_co2_flx = 0._wp 
    254  
     250      ! 
    255251   END SUBROUTINE p4z_flx_init 
    256252 
     253 
    257254   INTEGER FUNCTION p4z_flx_alloc() 
    258255      !!---------------------------------------------------------------------- 
    259256      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    260257      !!---------------------------------------------------------------------- 
    261  
    262258      ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 
    263  
    264       IF( p4z_flx_alloc /= 0 ) CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays.') 
    265  
     259      ! 
     260      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
     261      ! 
    266262   END FUNCTION p4z_flx_alloc 
    267263 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    r2643 r2690  
    2323   PUBLIC   p4z_int_alloc 
    2424 
    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 
     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) :: xksilim = 16.5E-6   ! Half-saturation constant for the computation of the Si half-saturation constant 
    30  
     28   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation 
    3129 
    3230   !!---------------------------------------------------------------------- 
    3331   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    3432   !! $Id$  
    35    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3634   !!---------------------------------------------------------------------- 
    37  
    3835CONTAINS 
    3936 
    … …  
    4643      !! ** Method  : - ??? 
    4744      !!--------------------------------------------------------------------- 
    48       !! 
    4945      INTEGER  ::   ji, jj 
    5046      REAL(wp) ::   zdum 
    … …  
    5349      ! Computation of phyto and zoo metabolic rate 
    5450      ! ------------------------------------------- 
    55  
    5651      tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 
    5752      tgfunc2(:,:,:) = EXP( 0.07608  * tsn(:,:,:,jp_tem) ) 
    … …  
    6055      ! constant for silica uptake 
    6156      ! --------------------------------------------------- 
    62  
    6357      DO ji = 1, jpi 
    6458         DO jj = 1, jpj 
    … …  
    6761         END DO 
    6862      END DO 
    69  
     63      ! 
    7064      IF( nday_year == nyear_len(1) ) THEN 
    7165         xksi    = xksimax 
    72          xksimax = 0.e0 
     66         xksimax = 0._wp 
    7367      ENDIF 
    7468      ! 
    7569   END SUBROUTINE p4z_int 
     70 
    7671 
    7772   INTEGER FUNCTION p4z_int_alloc() 
    … …  
    7974      !!                     ***  ROUTINE p4z_int_alloc  *** 
    8075      !!---------------------------------------------------------------------- 
    81  
    8276      ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 
    83  
    84       IF( p4z_int_alloc /= 0 ) CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
    85  
     77      ! 
     78      IF( p4z_int_alloc /= 0 )   CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
     79      ! 
    8680   END FUNCTION p4z_int_alloc 
    8781 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2643 r2690  
    2929   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy                 !: averaged PAR in the mixed layer 
    3030 
    31    INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    32    REAL(wp) ::  parlux = 0.43 / 3.e0 
    33  
    34    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb  !: tabulated attenuation coefficients for RGB absorption 
     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 
    3535    
    3636   !!* Substitution 
    … …  
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4040   !! $Id$  
    41    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    42    !!---------------------------------------------------------------------- 
    43  
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     42   !!---------------------------------------------------------------------- 
    4443CONTAINS 
    45  
    4644 
    4745   SUBROUTINE p4z_opt( kt, jnt ) 
    … …  
    5452      !! ** Method  : - ??? 
    5553      !!--------------------------------------------------------------------- 
    56       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    57       USE wrk_nemo, ONLY: zdepmoy => wrk_2d_1, zetmp => wrk_2d_2 
    58       USE wrk_nemo, ONLY: zekg    => wrk_3d_2, zekr  => wrk_3d_3, zekb => wrk_3d_4 
    59       USE wrk_nemo, ONLY: ze0     => wrk_3d_5, ze1   => wrk_3d_6 
    60       USE wrk_nemo, ONLY: ze2     => wrk_3d_7, ze3   => wrk_3d_8 
    61       ! 
    62       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      ! 
    6362      INTEGER  ::   ji, jj, jk 
    6463      INTEGER  ::   irgb 
    … …  
    6766      !!--------------------------------------------------------------------- 
    6867 
    69       IF( ( wrk_in_use(2, 1,2) ) .OR. ( wrk_in_use(3, 2,3,4,5,6,7,8) ) ) THEN 
    70          CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')  ;  RETURN 
    71       END IF 
     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 
    7271 
    7372      !     Initialisation of variables used to compute PAR 
    7473      !     ----------------------------------------------- 
    75       ze1 (:,:,jpk) = 0.e0 
    76       ze2 (:,:,jpk) = 0.e0 
    77       ze3 (:,:,jpk) = 0.e0 
     74      ze1 (:,:,jpk) = 0._wp 
     75      ze2 (:,:,jpk) = 0._wp 
     76      ze3 (:,:,jpk) = 0._wp 
    7877 
    7978      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    … …  
    211210!CDIR NOVERRCHK 
    212211            DO ji = 1, jpi 
    213                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) & 
    214        &           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 ) 
    215213            END DO 
    216214         END DO 
    … …  
    231229#endif 
    232230      ! 
    233       IF( ( wrk_not_released(2, 1,2) ) .OR. ( wrk_not_released(3, 2,3,4,5,6,7,8) ) ) & 
    234         &         CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
     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') 
    235233      ! 
    236234   END SUBROUTINE p4z_opt 
     235 
    237236 
    238237   SUBROUTINE p4z_opt_init 
    … …  
    241240      !! 
    242241      !! ** Purpose :   Initialization of tabulated attenuation coef 
    243       !! 
    244       !! 
    245       !!---------------------------------------------------------------------- 
    246  
     242      !!---------------------------------------------------------------------- 
     243      ! 
    247244      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
    248 !!      CALL trc_oce_rgb_read( xkrgb )               ! tabulated attenuation coefficients 
    249245      nksrp = trc_oce_ext_lev( r_si2, 0.33e2 )     ! max level of light extinction (Blue Chl=0.01) 
     246      ! 
    250247      IF(lwp) WRITE(numout,*) '        level of light extinction = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 
    251248      ! 
    252                          etot (:,:,:) = 0.e0 
    253                          enano(:,:,:) = 0.e0 
    254                          ediat(:,:,:) = 0.e0 
    255       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 
    256253      !  
    257254   END SUBROUTINE p4z_opt_init 
    258255 
     256 
    259257   INTEGER FUNCTION p4z_opt_alloc() 
    260258      !!---------------------------------------------------------------------- 
    261259      !!                     ***  ROUTINE p4z_opt_alloc  *** 
    262260      !!---------------------------------------------------------------------- 
    263  
    264       ALLOCATE( etot (jpi,jpj,jpk), enano(jpi,jpj,jpk), & 
    265         &       ediat(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc ) 
    266  
     261      ALLOCATE( etot (jpi,jpj,jpk) , enano(jpi,jpj,jpk) ,     & 
     262         &      ediat(jpi,jpj,jpk) , emoy (jpi,jpj,jpk) , STAT=p4z_opt_alloc ) 
     263         ! 
    267264      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 
    268  
     265      ! 
    269266   END FUNCTION p4z_opt_alloc 
    270267 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2643 r2690  
    2929   PUBLIC   p4z_prod_alloc 
    3030 
    31    !! * Shared module variables 
    3231   REAL(wp), PUBLIC ::   & 
    3332     pislope   = 3.0_wp          ,  &  !: 
    … …  
    4140     grosip    = 0.151_wp 
    4241 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax   !: 
    4443    
    4544   REAL(wp) ::   & 
    … …  
    5453   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5554   !! $Id$  
    56    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    57    !!---------------------------------------------------------------------- 
    58  
     55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     56   !!---------------------------------------------------------------------- 
    5957CONTAINS 
    60  
    6158 
    6259   SUBROUTINE p4z_prod( kt , jnt ) 
    … …  
    6966      !! ** Method  : - ??? 
    7067      !!--------------------------------------------------------------------- 
    71       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    72       USE wrk_nemo, ONLY: zmixnano    => wrk_2d_1 , zmixdiat     => wrk_2d_2, zstrn  => wrk_2d_3 
    73       USE wrk_nemo, ONLY: zpislopead  => wrk_3d_2 , zpislopead2 => wrk_3d_2 
    74       USE wrk_nemo, ONLY: zprdia      => wrk_3d_4 , zprbio       => wrk_3d_5, zysopt => wrk_3d_6 
    75       USE wrk_nemo, ONLY: zprorca     => wrk_3d_7 , zprorcad     => wrk_3d_8 
    76       USE wrk_nemo, ONLY: zprofed     => wrk_3d_9 , zprofen      => wrk_3d_10 
    77       USE wrk_nemo, ONLY: zprochln    => wrk_3d_11, zprochld     => wrk_3d_12 
    78       USE wrk_nemo, ONLY: zpronew     => wrk_3d_13, zpronewd     => wrk_3d_14 
     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_2 
     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 
    7976      ! 
    8077      INTEGER, INTENT(in) :: kt, jnt 
     78      ! 
    8179      INTEGER  ::   ji, jj, jk 
    8280      REAL(wp) ::   zsilfac, zfact 
    … …  
    9290      !!--------------------------------------------------------------------- 
    9391 
    94       IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) ) THEN 
    95          CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')  ;  RETURN 
    96       END IF 
    97  
    98       zprorca (:,:,:) = 0.0 
    99       zprorcad(:,:,:) = 0.0 
    100       zprofed(:,:,:) = 0.0 
    101       zprofen(:,:,:) = 0.0 
    102       zprochln(:,:,:) = 0.0 
    103       zprochld(:,:,:) = 0.0 
    104       zpronew (:,:,:) = 0.0 
    105       zpronewd(:,:,:) = 0.0 
    106       zprdia  (:,:,:) = 0.0 
    107       zprbio  (:,:,:) = 0.0 
    108       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 
    109108 
    110109      ! Computation of the optimal production 
    111  
    112110# if defined key_degrad 
    113111      prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
    … …  
    117115 
    118116      ! compute the day length depending on latitude and the day 
    119       zrum = FLOAT( nday_year - 80 ) / REAL(nyear_len(1), wp) 
    120       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 )  ) 
    121119 
    122120      ! day length in hours 
    123       zstrn(:,:) = 0. 
     121      zstrn(:,:) = 0._wp 
    124122      DO jj = 1, jpj 
    125123         DO ji = 1, jpi 
    … …  
    362360#endif 
    363361 
    364        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     362      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    365363         WRITE(charout, FMT="('prod')") 
    366364         CALL prt_ctl_trc_info(charout) 
    367365         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    368        ENDIF 
    369  
    370       IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) ) & 
    371         &         CALL ctl_stop('p4z_prod: failed to release workspace arrays') 
     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') 
    372371      ! 
    373372   END SUBROUTINE p4z_prod 
    374373 
     374 
    375375   SUBROUTINE p4z_prod_init 
    376  
    377376      !!---------------------------------------------------------------------- 
    378377      !!                  ***  ROUTINE p4z_prod_init  *** 
    … …  
    384383      !! 
    385384      !! ** input   :   Namelist nampisprod 
    386       !! 
    387385      !!---------------------------------------------------------------------- 
    388  
    389386      NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm,   & 
    390387         &              fecnm, fecdm, grosip 
     388      !!---------------------------------------------------------------------- 
    391389 
    392390      REWIND( numnat )                     ! read numnat 
    … …  
    407405         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
    408406      ENDIF 
    409  
     407      ! 
    410408      rday1     = 0.6 / rday  
    411409      texcret   = 1.0 - excret 
    412410      texcret2  = 1.0 - excret2 
    413411      tpp       = 0. 
    414  
     412      ! 
    415413   END SUBROUTINE p4z_prod_init 
    416414 
    … …  
    420418      !!                     ***  ROUTINE p4z_prod_alloc  *** 
    421419      !!---------------------------------------------------------------------- 
    422  
    423420      ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 
    424  
     421      ! 
    425422      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 
    426  
     423      ! 
    427424   END FUNCTION p4z_prod_alloc 
    428425 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r2643 r2690  
    3131   PUBLIC   p4z_rem_alloc 
    3232 
    33    !! * Shared module variables 
    3433   REAL(wp), PUBLIC ::   & 
    3534     xremik  = 0.3_wp      ,  & !: 
    … …  
    4039     oxymin  = 1.e-6_wp         !: 
    4140 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: 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 
    54  
    5552 
    5653   SUBROUTINE p4z_rem( kt ) 
    … …  
    6259      !! ** Method  : - ??? 
    6360      !!--------------------------------------------------------------------- 
    64       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    65       USE wrk_nemo, ONLY: ztempbac => wrk_2d_1 
    66       USE wrk_nemo, ONLY: zdepbac  => wrk_3d_2, zfesatur => wrk_3d_2, zolimi => wrk_3d_4 
     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 
    6764      ! 
    6865      INTEGER, INTENT(in) ::   kt ! ocean time step 
     66      ! 
    6967      INTEGER  ::   ji, jj, jk 
    7068      REAL(wp) ::   zremip, zremik , zlam1b 
    … …  
    7876      REAL(wp) ::   zlamfac, zonitr, zstep 
    7977      CHARACTER (len=25) :: charout 
    80  
    8178      !!--------------------------------------------------------------------- 
    8279 
    83       IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 2,3,4) ) ) THEN 
    84          CALL ctl_stop('p4z_rem: requested workspace arrays unavailable')  ;  RETURN 
    85       END IF 
     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 
    8683 
    8784       ! Initialisation of temprary arrys 
    88        zdepbac (:,:,:) = 0.0 
    89        zfesatur(:,:,:) = 0.0 
    90        zolimi  (:,:,:) = 0.0 
    91        ztempbac(:,:)   = 0.0 
     85       zdepbac (:,:,:) = 0._wp 
     86       zfesatur(:,:,:) = 0._wp 
     87       zolimi  (:,:,:) = 0._wp 
     88       ztempbac(:,:)   = 0._wp 
    9289 
    9390      !  Computation of the mean phytoplankton concentration as 
    9491      !  a crude estimate of the bacterial biomass 
    9592      !   -------------------------------------------------- 
    96  
    9793      DO jk = 1, jpkm1 
    9894         DO jj = 1, jpj 
    … …  
    368364               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 
    369365#endif 
    370  
    371             END DO 
    372          END DO 
    373       END DO 
    374       ! 
    375  
    376        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) 
    377372         WRITE(charout, FMT="('rem5')") 
    378373         CALL prt_ctl_trc_info(charout) 
    379374         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    380        ENDIF 
    381  
    382        !     Update the arrays TRA which contain the biological sources and sinks 
    383        !     -------------------------------------------------------------------- 
     375      ENDIF 
     376 
     377      !     Update the arrays TRA which contain the biological sources and sinks 
     378      !     -------------------------------------------------------------------- 
    384379 
    385380      DO jk = 1, jpkm1 
    … …  
    391386         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 
    392387         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 
    393      END DO 
    394  
    395        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) 
    396391         WRITE(charout, FMT="('rem6')") 
    397392         CALL prt_ctl_trc_info(charout) 
    398393         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    399        ENDIF 
    400  
    401       IF( ( wrk_not_released(2, 1) ) .OR. ( wrk_not_released(3, 2,3,4) ) )  & 
    402         &         CALL ctl_stop('p4z_rem: failed to release workspace arrays') 
    403  
     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      ! 
    404399   END SUBROUTINE p4z_rem 
    405400 
     401 
    406402   SUBROUTINE p4z_rem_init 
    407  
    408403      !!---------------------------------------------------------------------- 
    409404      !!                  ***  ROUTINE p4z_rem_init  *** 
    … …  
    417412      !! 
    418413      !!---------------------------------------------------------------------- 
    419  
    420414      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xlam1, oxymin 
     415      !!---------------------------------------------------------------------- 
    421416 
    422417      REWIND( numnat )                     ! read numnat 
    … …  
    434429         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin    =', oxymin 
    435430      ENDIF 
    436  
    437       nitrfac(:,:,:) = 0.0 
    438       denitr (:,:,:) = 0.0   
    439  
     431      ! 
     432      nitrfac(:,:,:) = 0._wp 
     433      denitr (:,:,:) = 0._wp 
     434      ! 
    440435   END SUBROUTINE p4z_rem_init 
     436 
    441437 
    442438   INTEGER FUNCTION p4z_rem_alloc() 
    … …  
    444440      !!                     ***  ROUTINE p4z_rem_alloc  *** 
    445441      !!---------------------------------------------------------------------- 
    446  
    447442      ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
    448  
    449       IF( p4z_rem_alloc /= 0 ) CALL ctl_warn('p4z_rem_alloc : failed to allocate arrays.') 
    450  
     443      ! 
     444      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 
     445      ! 
    451446   END FUNCTION p4z_rem_alloc 
     447 
    452448#else 
    453449   !!====================================================================== 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r2643 r2690  
    2323   PUBLIC   p4z_sink_alloc 
    2424 
    25    !! * Shared module variables 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio3   !: POC sinking speed  
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wsbio4   !: GOC sinking speed 
    28    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wscal    !: Calcite and BSi sinking speeds 
    29  
    30    !! * Module variables 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinking, sinking2  !: POC sinking fluxes  
    32    !                                                                 !  (different meanings depending on the parameterization) 
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes 
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer            !: Small BFe sinking fluxes 
     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 
    3533#if ! defined key_kriest 
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer2           !: Big iron sinking fluxes 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer2           !: Big iron sinking fluxes 
    3735#endif 
    3836 
    … …  
    5654   REAL(wp), PUBLIC ::  xkr_wsbio_max   !: max vertical particle speed 
    5755 
    58    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: xnumm  !:  maximum number of particles in aggregates 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   xnumm   !:  maximum number of particles in aggregates 
    5957#endif 
    6058 
    … …  
    6462   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    6563   !! $Id$  
    66    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     64   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6765   !!---------------------------------------------------------------------- 
    68  
    6966CONTAINS 
    7067 
    71  
    7268#if defined key_kriest 
     69   !!---------------------------------------------------------------------- 
     70   !!   'key_kriest'                                                    ??? 
     71   !!---------------------------------------------------------------------- 
    7372 
    7473   SUBROUTINE p4z_sink ( kt, jnt ) 
    … …  
    8180      !! ** Method  : - ??? 
    8281      !!--------------------------------------------------------------------- 
    83       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    84       USE wrk_nemo, ONLY: znum3d    => wrk_3d_2 
     82      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     83      USE wrk_nemo, ONLY:   znum3d => wrk_3d_2 
     84      ! 
    8585      INTEGER, INTENT(in) :: kt, jnt 
     86      ! 
    8687      INTEGER  :: ji, jj, jk 
    8788      REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 
    … …  
    9596#endif 
    9697      CHARACTER (len=25) :: charout 
    97  
    98       !!--------------------------------------------------------------------- 
    99  
     98      !!--------------------------------------------------------------------- 
     99      ! 
    100100      IF( wrk_in_use(3, 2 ) ) THEN 
    101          CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')  ;  RETURN 
    102       END IF 
     101         CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')   ;   RETURN 
     102      ENDIF 
     103       
    103104      !     Initialisation of variables used to compute Sinking Speed 
    104105      !     --------------------------------------------------------- 
    105106 
    106        znum3d(:,:,:) = 0.e0 
    107        zval1 = 1. + xkr_zeta 
    108        zval2 = 1. + xkr_zeta + xkr_eta 
    109        zval3 = 1. + xkr_eta 
    110  
    111      !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
    112      !     ----------------------------------------------------------------- 
     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      !     ----------------------------------------------------------------- 
    113114 
    114115      DO jk = 1, jpkm1 
    … …  
    128129                  zdiv1 = zeps - zval3 
    129130                  wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv    & 
    130      &                             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv 
     131                     &             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv 
    131132                  wsbio4(ji,jj,jk) = xkr_wsbio_min *   ( zeps-1. )    / zdiv1   & 
    132      &                             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1 
     133                     &             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1 
    133134                  IF( znum == 1.1)   wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk) 
    134135               ENDIF 
    … …  
    137138      END DO 
    138139 
    139       wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. ) 
     140      wscal(:,:,:) = MAX( wsbio3(:,:,:), 50._wp ) 
    140141 
    141142      !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    … …  
    302303#endif 
    303304      ! 
    304        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     305      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    305306         WRITE(charout, FMT="('sink')") 
    306307         CALL prt_ctl_trc_info(charout) 
    307308         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    308        ENDIF 
    309  
    310       IF( wrk_not_released(3, 2 ) ) CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
     309      ENDIF 
     310      ! 
     311      IF( wrk_not_released(3, 2 ) )   CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
    311312      ! 
    312313   END SUBROUTINE p4z_sink 
     314 
    313315 
    314316   SUBROUTINE p4z_sink_init 
    … …  
    323325      !! 
    324326      !! ** input   :   Namelist nampiskrs 
    325       !! 
    326327      !!---------------------------------------------------------------------- 
    327328      INTEGER  ::   jk, jn, kiter 
    … …  
    329330      REAL(wp) ::   zws, zwr, zwl,wmax, znummax 
    330331      REAL(wp) ::   zmin, zmax, zl, zr, xacc 
    331  
     332      ! 
    332333      NAMELIST/nampiskrs/ xkr_sfact, xkr_stick ,  & 
    333334         &                xkr_nnano, xkr_ndiat, xkr_nmeso, xkr_naggr 
    334  
    335335      !!---------------------------------------------------------------------- 
     336      ! 
    336337      REWIND( numnat )                     ! read nampiskrs 
    337338      READ  ( numnat, nampiskrs ) 
    … …  
    346347         WRITE(numout,*) '    Nbr of cell in mesozoo size class        xkr_nmeso    = ', xkr_nmeso 
    347348         WRITE(numout,*) '    Nbr of cell in aggregates size class     xkr_naggr    = ', xkr_naggr 
    348      ENDIF 
    349  
    350  
    351      ! max and min vertical particle speed 
    352      xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
    353      xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
    354      WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
    355  
    356      ! 
    357      !    effect of the sizes of the different living pools on particle numbers 
    358      !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337 
    359      !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718 
    360      !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147 
    361      !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877 
    362      !    doc aggregates = 1um 
    363      ! ---------------------------------------------------------- 
    364  
    365      xkr_dnano = 1. / ( xkr_massp * xkr_nnano ) 
    366      xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat ) 
    367      xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso ) 
    368      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 ) 
    369370 
    370371      !!--------------------------------------------------------------------- 
    … …  
    378379      WRITE(numout,*)'    kriest : Compute maximum number of particles in aggregates' 
    379380 
    380       xacc     =  0.001 
     381      xacc     =  0.001_wp 
    381382      kiter    = 50 
    382       zmin     =  1.10 
     383      zmin     =  1.10_wp 
    383384      zmax     = xkr_mass_max / xkr_mass_min 
    384385      xkr_frac = zmax 
    … …  
    401402            &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    402403            & - wmax 
    403 iflag:  DO jn = 1, kiter 
    404            IF( zwl == 0.e0 ) THEN 
    405               znummax = zl 
    406            ELSE IF ( zwr == 0.e0 ) THEN 
    407               znummax = zr 
    408            ELSE 
    409               znummax = ( zr + zl ) / 2. 
    410               zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 
    411               znum = znummax - 1. 
    412               zws =  xkr_wsbio_min * xkr_zeta / zdiv & 
    413                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    414                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    415                  & - wmax 
    416               IF( zws * zwl < 0. ) THEN 
    417                  zr = znummax 
    418               ELSE 
    419                  zl = znummax 
    420               ENDIF 
    421               zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
    422               znum = zl - 1. 
    423               zwl =  xkr_wsbio_min * xkr_zeta / zdiv & 
    424                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    425                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    426                  & - wmax 
    427  
    428               zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 
    429               znum = zr - 1. 
    430               zwr =  xkr_wsbio_min * xkr_zeta / zdiv & 
    431                  & - ( xkr_wsbio_max * xkr_eta * znum * & 
    432                  &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    433                  & - wmax 
    434  
    435               IF ( ABS ( zws )  <= xacc ) EXIT iflag 
    436  
    437            ENDIF 
    438  
    439         END DO iflag 
    440  
    441         xnumm(jk) = znummax 
    442         WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 
    443  
    444      END DO 
    445  
     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      ! 
    446443  END SUBROUTINE p4z_sink_init 
    447444 
    … …  
    475472         DO jj = 1, jpj 
    476473            DO ji=1,jpi 
    477                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 
    478475               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    479476            END DO 
    … …  
    583580#endif 
    584581      ! 
    585        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     582      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    586583         WRITE(charout, FMT="('sink')") 
    587584         CALL prt_ctl_trc_info(charout) 
    588585         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    589        ENDIF 
    590  
     586      ENDIF 
     587      ! 
    591588   END SUBROUTINE p4z_sink 
     589 
    592590 
    593591   SUBROUTINE p4z_sink_init 
    … …  
    705703      END DO 
    706704 
    707       trn(:,:,:,jp_tra) = trb(:,:,:,jp_tra) 
    708       psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
    709  
    710       IF( wrk_not_released(3, 2,3,4 ) ) CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 
     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') 
    711709      ! 
    712710   END SUBROUTINE p4z_sink2 
     711 
    713712 
    714713   INTEGER FUNCTION p4z_sink_alloc() 
    … …  
    716715      !!                     ***  ROUTINE p4z_sink_alloc  *** 
    717716      !!---------------------------------------------------------------------- 
    718  
    719       ALLOCATE( wsbio3(jpi,jpj,jpk), wsbio4(jpi,jpj,jpk), wscal(jpi,jpj,jpk),  & 
    720         &       sinking(jpi,jpj,jpk), sinking2(jpi,jpj,jpk)                 ,  &                 
    721         &       sinkcal(jpi,jpj,jpk), sinksil(jpi,jpj,jpk)                  ,  &                 
     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)                      ,     &                 
    722720#if defined key_kriest 
    723         &       xnumm(jpk)                                                  ,  &                 
     721         &      xnumm(jpk)                                                        ,     &                 
    724722#else 
    725         &       sinkfer2(jpi,jpj,jpk)                                       ,  &                 
    726 #endif 
    727  
    728         &       sinkfer(jpi,jpj,jpk), STAT=p4z_sink_alloc )                 
    729  
     723         &      sinkfer2(jpi,jpj,jpk)                                             ,     &                 
     724#endif 
     725         &      sinkfer(jpi,jpj,jpk)                                              , STAT=p4z_sink_alloc )                 
     726         ! 
    730727      IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 
    731  
     728      ! 
    732729   END FUNCTION p4z_sink_alloc 
     730    
    733731#else 
    734732   !!====================================================================== 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r2643 r2690  
    77   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style 
    88   !!---------------------------------------------------------------------- 
    9  
    109#if defined key_pisces 
    1110   !!---------------------------------------------------------------------- 
    … …  
    8786#endif 
    8887 
     88   !!---------------------------------------------------------------------- 
     89   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     90   !! $Id$  
     91   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     92   !!---------------------------------------------------------------------- 
    8993CONTAINS 
    9094 
    … …  
    9498      !!---------------------------------------------------------------------- 
    9599      USE lib_mpp , ONLY: ctl_warn 
    96       INTEGER :: ierr(5)        ! Local variables 
     100      INTEGER ::   ierr(5)        ! Local variables 
    97101      !!---------------------------------------------------------------------- 
    98  
    99102      ierr(:) = 0 
    100  
     103      ! 
    101104      !*  Biological fluxes for light 
    102105      ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                           STAT=ierr(1) ) 
    103  
     106      ! 
    104107      !*  Biological fluxes for primary production 
    105108      ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,               & 
    … …  
    108111         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),               & 
    109112         &      concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk),           STAT=ierr(2) )  
    110  
     113         ! 
    111114      !*  SMS for the organic matter 
    112115      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk),               & 
    … …  
    115118#endif  
    116119         &      xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk)   ,           STAT=ierr(3) )   
    117  
     120         ! 
    118121      !* Variable for chemistry of the CO2 cycle 
    119122      ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) ,                      & 
    120123         &      ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) ,                      & 
    121124         &      akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 
    122  
     125         ! 
    123126      !* Array used to indicate negative tracer values   
    124127      ALLOCATE( xnegtr(jpi,jpj,jpk),                                    STAT=ierr(5) ) 
    125  
     128      ! 
    126129      sms_pisces_alloc = MAXVAL( ierr ) 
    127  
    128       IF( sms_pisces_alloc /= 0 ) CALL ctl_warn('sms_pisces_alloc : failed to allocate arrays.')  
    129  
     130      ! 
     131      IF( sms_pisces_alloc /= 0 )   CALL ctl_warn('sms_pisces_alloc: failed to allocate arrays')  
     132      ! 
    130133   END FUNCTION sms_pisces_alloc 
    131134 
    … …  
    136139#endif 
    137140    
    138    !!---------------------------------------------------------------------- 
    139    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    140    !! $Id$  
    141    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    142141   !!======================================================================    
    143142END MODULE sms_pisces     

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r2643 r2690  
    3434   PUBLIC   trc_ini_pisces   ! called by trcini.F90 module 
    3535 
    36    !! * Module variables 
    37    REAL(wp) :: sco2   =  2.312e-3  
    38    REAL(wp) :: alka0  =  2.423e-3 
    39    REAL(wp) :: oxyg0  =  177.6e-6  
    40    REAL(wp) :: po4    =  2.174e-6  
    41    REAL(wp) :: bioma0 =  1.000e-8   
    42    REAL(wp) :: silic1 =  91.65e-6   
    43    REAL(wp) :: 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 
    4443 
    4544#  include "top_substitute.h90" 
    … …  
    4746   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4847   !! $Id$  
    49    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5049   !!---------------------------------------------------------------------- 
    51  
    5250CONTAINS 
    5351 
    … …  
    5856      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    5957      !!---------------------------------------------------------------------- 
    60  
    61  
     58      ! 
    6259      IF(lwp) WRITE(numout,*) 
    6360      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
    6461      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    65  
    6662 
    6763      CALL pisces_alloc()                          ! Allocate PISCES arrays 
    … …  
    130126      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    131127      IF(lwp) WRITE(numout,*) ' ' 
    132  
    133128      ! 
    134129   END SUBROUTINE trc_ini_pisces 
     130 
    135131 
    136132   SUBROUTINE pisces_alloc 
    … …  
    162158      ! 
    163159      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    164       IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc : unable to allocate PISCES arrays' ) 
    165  
     160      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 
    166161      ! 
    167162   END SUBROUTINE pisces_alloc 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r2643 r2690  
    3535   INTEGER ::   nadv   ! choice of the type of advection scheme 
    3636   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    37       !                                ! except at nit000 (=rdttra) if neuler=0 
     37   !                                                    ! except at nit000 (=rdttra) if neuler=0 
    3838 
    3939   !! * Substitutions 
    … …  
    4545   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    47  
    4847CONTAINS 
    4948 
    … …  
    6968      !!---------------------------------------------------------------------- 
    7069      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    71       USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, & 
    72                           zwn => wrk_3d_6   ! effective velocity 
     70      USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, zwn => wrk_3d_6   ! effective velocity 
    7371      !! 
    74       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    75       ! 
    76       INTEGER :: jk  
    77       CHARACTER (len=22) :: charout 
    78       !!---------------------------------------------------------------------- 
    79  
     72      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     73      ! 
     74      INTEGER ::   jk  
     75      CHARACTER (len=22) ::   charout 
     76      !!---------------------------------------------------------------------- 
     77      ! 
    8078      IF( wrk_in_use(3, 4,5,6) ) THEN 
    81          CALL ctl_stop('trc_adv : requested workspace arrays unavailable.') 
    82          RETURN 
    83       END IF 
     79         CALL ctl_stop('trc_adv : requested workspace arrays unavailable')   ;   RETURN 
     80      ENDIF 
    8481 
    8582      IF( kt == nit000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    … …  
    191188      ! 
    192189   END SUBROUTINE trc_adv_ctl 
     190    
    193191#else 
    194192   !!---------------------------------------------------------------------- 
    … …  
    201199   END SUBROUTINE trc_adv 
    202200#endif 
     201 
    203202  !!====================================================================== 
    204203END MODULE trcadv 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r2606 r2690  
    3333 
    3434   LOGICAL , PUBLIC, PARAMETER ::   lk_trcdmp = .TRUE.   !: internal damping flag 
    35    !                             !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
     35 
     36   !                                !!* Namelist namtrc_dmp : passive tracer newtonian damping * 
    3637   INTEGER  ::   nn_hdmp_tr =   -1   ! = 0/-1/'latitude' for damping over passive tracer 
    3738   INTEGER  ::   nn_zdmp_tr =    0   ! = 0/1/2 flag for damping in the mixed layer 
    … …  
    4849   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4950   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp $  
    50    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    51    !!---------------------------------------------------------------------- 
    52  
     51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     52   !!---------------------------------------------------------------------- 
    5353CONTAINS 
    5454 
    55    FUNCTION trc_dmp_alloc() 
     55   INTEGER FUNCTION trc_dmp_alloc() 
    5656      !!---------------------------------------------------------------------- 
    5757      !!                   ***  ROUTINE trc_dmp_alloc  *** 
    5858      !!---------------------------------------------------------------------- 
    59       INTEGER :: trc_dmp_alloc 
    60       !!---------------------------------------------------------------------- 
    61  
    62       ALLOCATE(restotr(jpi,jpj,jpk), Stat=trc_dmp_alloc) 
    63  
    64       IF(trc_dmp_alloc /= 0)THEN 
    65          CALL ctl_warn('trc_dmp_alloc : failed to allocate array.') 
    66       END IF 
    67  
     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      ! 
    6863   END FUNCTION trc_dmp_alloc 
    6964 
    … …  
    178173      !! 
    179174      !! ** Method  :   read the nammbf namelist and check the parameters 
    180       !!      called by trc_dmp at the first timestep (nit000) 
     175      !!              called by trc_dmp at the first timestep (nit000) 
    181176      !!---------------------------------------------------------------------- 
    182177 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r2643 r2690  
    5757      !!                   ***  ROUTINE trc_nxt_alloc  *** 
    5858      !!---------------------------------------------------------------------- 
    59       ! 
    60       ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc) 
     59      ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc ) 
    6160      ! 
    6261      IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array') 
    … …  
    8988      !! ** Action  : - update trb, trn 
    9089      !!---------------------------------------------------------------------- 
    91       !! * Arguments 
    9290      INTEGER, INTENT( in ) ::   kt     ! ocean time-step index 
    93       !! * Local declarations 
     91      ! 
    9492      INTEGER  ::   jk, jn   ! dummy loop indices 
    9593      REAL(wp) ::   zfact            ! temporary scalar 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r2643 r2690  
    1010   !!---------------------------------------------------------------------- 
    1111   !!   'key_top'                                                TOP models 
    12    !!---------------------------------------------------------------------- 
    1312   !!---------------------------------------------------------------------- 
    1413   !!   trc_ldf     : update the tracer trend with the lateral diffusion 
    … …  
    3332      !                                ! defined from ln_zdf...  namlist logicals) 
    3433   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
    35       !                                ! except at nit000 (=rdttra) if neuler=0 
     34      !                                                 ! except at nit000 (=rdttra) if neuler=0 
    3635 
    3736   !! * Substitutions 
    … …  
    4241   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4342   !! $Id$  
    44    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     43   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4544   !!---------------------------------------------------------------------- 
    46  
    4745CONTAINS 
    4846    
    49    FUNCTION trc_zdf_alloc() 
     47   INTEGER FUNCTION trc_zdf_alloc() 
    5048      !!---------------------------------------------------------------------- 
    5149      !!                  ***  ROUTINE trc_zdf_alloc  *** 
    5250      !!---------------------------------------------------------------------- 
    53       INTEGER :: trc_zdf_alloc 
    54       !!---------------------------------------------------------------------- 
    55  
    56       ALLOCATE(r2dt(jpk), Stat=trc_zdf_alloc) 
    57  
    58       IF(trc_zdf_alloc /= 0)THEN 
    59          CALL ctl_warn('trc_zdf_alloc : failed to allocate array.') 
    60       END IF 
    61  
     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      ! 
    6255   END FUNCTION trc_zdf_alloc 
    6356 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    r2643 r2690  
    7272   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    7373   !! $Header:  $  
    74    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     74   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    7575   !!---------------------------------------------------------------------- 
    76  
    7776CONTAINS 
    7877 
    79    FUNCTION trd_mld_trc_alloc() 
     78   INTEGER FUNCTION trd_mld_trc_alloc() 
    8079      !!---------------------------------------------------------------------- 
    8180      !!                  ***  ROUTINE trd_mld_trc_alloc  *** 
    8281      !!---------------------------------------------------------------------- 
    83       INTEGER :: trd_mld_trc_alloc 
    84       !!---------------------------------------------------------------------- 
    85  
    86       ALLOCATE(ztmltrd2(jpi,jpj,jpltrd_trc,jptra), & 
     82      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) ,      & 
    8783#if defined key_lobster 
    88                ztmltrdbio2(jpi,jpj,jpdiabio)     , & 
    89 #endif 
    90          &     ndextrd1(jpi*jpj)                 ,  STAT=trd_mld_trc_alloc) 
     84         &      ztmltrdbio2(jpi,jpj,jpdiabio)      ,      & 
     85#endif 
     86         &      ndextrd1(jpi*jpj)                  ,  STAT=trd_mld_trc_alloc) 
    9187         ! 
    9288      IF( lk_mpp                )   CALL mpp_sum ( trd_mld_trc_alloc ) 
    93       IF( trd_mld_trc_alloc /=0 )   CALL ctl_warn('trd_mld_trc_alloc : failed to allocate arrays.') 
     89      IF( trd_mld_trc_alloc /=0 )   CALL ctl_warn('trd_mld_trc_alloc: failed to allocate arrays') 
     90      ! 
    9491   END FUNCTION trd_mld_trc_alloc 
    9592 
    … …  
    115112      !!            surface and the control surface is called "mixed-layer" 
    116113      !!---------------------------------------------------------------------- 
    117       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    118       USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 
     114      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     115      USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1 
    119116      !! 
    120117      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank 
    … …  
    125122 
    126123      IF( wrk_in_use(2, 1) ) THEN 
    127          CALL ctl_stop('trd_mld_trc_zint : requested workspace array unavailable')   ;   RETURN 
    128       END IF 
     124         CALL ctl_stop('trd_mld_trc_zint: requested workspace array unavailable')   ;   RETURN 
     125      ENDIF 
    129126 
    130127      ! I. Definition of control surface and integration weights 
    … …  
    210207            tmltrd_trc(:,:,ktrd,kjn) = tmltrd_trc(:,:,ktrd,kjn) + ptrc_trdmld(:,:,1) * wkx_trc(:,:,1)  ! non penetrative 
    211208      END SELECT 
    212  
    213       IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_trc_zint : failed to release workspace array.') 
    214       ! 
    215     END SUBROUTINE trd_mld_trc_zint 
    216  
    217  
    218     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 ) 
    219216      !!---------------------------------------------------------------------- 
    220217      !!                  ***  ROUTINE trd_mld_bio_zint  *** 
    … …  
    234231      !!            surface and the control surface is called "mixed-layer" 
    235232      !!---------------------------------------------------------------------- 
    236       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    237       USE wrk_nemo, ONLY: zvlmsk => wrk_2d_1 
    238       !! 
    239       INTEGER, INTENT( in ) ::   ktrd          ! bio trend index 
    240       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 
    241238#if defined key_lobster 
    242       !! local variables 
     239      ! 
    243240      INTEGER ::   ji, jj, jk, isum 
    244241      !!---------------------------------------------------------------------- 
    245242 
    246243      IF( wrk_in_use(2, 1) ) THEN 
    247          CALL ctl_stop('trd_mld_bio_zint : requested workspace array unavailable.') ; RETURN 
    248       END IF 
     244         CALL ctl_stop('trd_mld_bio_zint: requested workspace array unavailable')   ;  RETURN 
     245      ENDIF 
    249246 
    250247      ! I. Definition of control surface and integration weights 
    … …  
    328325      END DO 
    329326 
    330       IF( wrk_not_released(2, 1) ) CALL ctl_stop('trd_mld_bio_zint : failed to release workspace array.') 
    331 #endif 
    332  
    333     END SUBROUTINE trd_mld_bio_zint 
    334  
    335  
    336     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 ) 
    337334      !!---------------------------------------------------------------------- 
    338335      !!                  ***  ROUTINE trd_mld_trc  *** 
    … …  
    385382      USE wrk_nemo, ONLY:   wrk_3d_5, wrk_3d_6, wrk_3d_7, wrk_3d_8, wrk_3d_9 
    386383      ! 
    387       INTEGER, INTENT( in ) ::   kt                               ! ocean time-step index 
     384      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     385      ! 
    388386      INTEGER ::   ji, jj, jk, jl, ik, it, itmod, jn 
    389387      REAL(wp) ::   zavt, zfn, zfn2 
    390       !! 
     388      ! 
    391389      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot             ! d(trc)/dt over the anlysis window (incl. Asselin) 
    392390      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres             ! residual = dh/dt entrainment term 
    393391      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlatf             ! for storage only 
    394392      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad             ! for storage only (for trb<0 corr in trcrad) 
    395       !! 
     393      ! 
    396394      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmltot2            ! -+ 
    397395      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlres2            !  | working arrays to diagnose the trends 
    … …  
    400398      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad2            !  | (-> for trb<0 corr in trcrad) 
    401399      !REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  ztmltrd2  ! -+ 
    402       !! 
     400      ! 
    403401      CHARACTER (LEN= 5) ::   clvar 
    404402#if defined key_dimgout 
    … …  
    423421 
    424422 
    425       IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " ) 
     423      IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " ) 
    426424 
    427425      ! ====================================================================== 
    … …  
    448446 
    449447         DO jn = 1, jptra 
    450          ! ... 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) 
    451449            IF( ln_trdtrc(jn) ) & 
    452450                 tmltrd_trc(:,:,jpmld_trc_ldf,jn) = tmltrd_trc(:,:,jpmld_trc_ldf,jn) - tmltrd_trc(:,:,jpmld_trc_zdf,jn) 
    … …  
    909907      IF( lrst_trc )   CALL trd_mld_trc_rst_write( kt )  ! this must be after the array swap above (III.3) 
    910908 
    911       IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9) ) & 
    912       &   CALL ctl_stop('trd_mld_trc : failed to release workspace arrays.') 
     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') 
    913910      ! 
    914911   END SUBROUTINE trd_mld_trc 
    915912 
    916     SUBROUTINE trd_mld_bio( kt ) 
     913 
     914   SUBROUTINE trd_mld_bio( kt ) 
    917915      !!---------------------------------------------------------------------- 
    918916      !!                  ***  ROUTINE trd_mld  *** 
    … …  
    11491147   END SUBROUTINE trd_mld_bio 
    11501148 
     1149 
    11511150   REAL FUNCTION sum2d( ztab ) 
    11521151      !!---------------------------------------------------------------------- 
    … …  
    11551154      REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) ::  ztab       
    11561155      !!---------------------------------------------------------------------- 
    1157       sum2d = SUM(ztab(2:jpi-1,2:jpj-1)) 
     1156      sum2d = SUM( ztab(2:jpi-1,2:jpj-1) ) 
    11581157   END FUNCTION sum2d 
     1158 
    11591159 
    11601160   SUBROUTINE trd_mld_trc_init 
    … …  
    14421442   !!   Default option :                                       Empty module 
    14431443   !!---------------------------------------------------------------------- 
    1444  
    14451444CONTAINS 
    1446  
    14471445   SUBROUTINE trd_mld_trc( kt )                                   ! Empty routine 
    14481446      INTEGER, INTENT( in) ::   kt 
    14491447      WRITE(*,*) 'trd_mld_trc: You should not have seen this print! error?', kt 
    14501448   END SUBROUTINE trd_mld_trc 
    1451  
    14521449   SUBROUTINE trd_mld_bio( kt ) 
    14531450      INTEGER, INTENT( in) ::   kt 
    14541451      WRITE(*,*) 'trd_mld_bio: You should not have seen this print! error?', kt 
    14551452   END SUBROUTINE trd_mld_bio 
    1456  
    14571453   SUBROUTINE trd_mld_trc_zint( ptrc_trdmld, ktrd, ctype, kjn ) 
    14581454      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank 
    … …  
    14641460      WRITE(*,*) '  "      "      : You should not have seen this print! error?', kjn 
    14651461   END SUBROUTINE trd_mld_trc_zint 
    1466  
    14671462   SUBROUTINE trd_mld_trc_init                                    ! Empty routine 
    14681463      WRITE(*,*) 'trd_mld_trc_init: You should not have seen this print! error?' 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/TRP/trdmod_trc_oce.F90

    r2643 r2690  
    88   !!   'key_top'                                                TOP models 
    99   !!---------------------------------------------------------------------- 
    10  
    1110   USE par_oce       ! ocean parameters 
    1211   USE par_trc       ! passive tracers parameters 
    … …  
    2322   CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input) 
    2423   CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output) 
    25    LOGICAL, DIMENSION (jptra) ::   ln_trdtrc  !: large trends diagnostic to write or not (namelist) 
     24   LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
    2625 
    2726# if defined key_trdtrc && defined key_iomput 
    … …  
    117116                                                 !: upper triangle 
    118117#endif 
    119  
    120118   !!---------------------------------------------------------------------- 
    121119   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    122120   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmld_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp $  
    123    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     121   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    124122   !!---------------------------------------------------------------------- 
    125123CONTAINS 
    … …  
    132130      INTEGER :: ierr(2) 
    133131      !!---------------------------------------------------------------------- 
    134  
    135132      ierr(:) = 0 
    136  
     133      ! 
    137134# if defined key_trdmld_trc 
    138135      ALLOCATE(nmld_trc(jpi,jpj),          nbol_trc(jpi,jpj),           & 
    … …  
    149146               tmlradn_trc(jpi,jpj,jptra), tmlradm_trc(jpi,jpj,jptra),  & 
    150147               ! 
    151                tmltrd_trc(jpi,jpj,jpltrd_trc,jptra)        , & 
    152                tmltrd_sum_trc(jpi,jpj,jpltrd_trc,jptra)    , & 
    153                tmltrd_csum_ln_trc(jpi,jpj,jpltrd_trc,jptra), & 
    154                tmltrd_csum_ub_trc(jpi,jpj,jpltrd_trc,jptra), & 
     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) , & 
    155152               ! 
    156                tmltrdm_trc(jpi,jpj,jptra),                   & 
    157                Stat=ierr(1)) 
     153               tmltrdm_trc(jpi,jpj,jptra)                   , STAT=ierr(1) ) 
    158154#endif 
    159  
     155      ! 
    160156# if defined key_lobster 
    161       ALLOCATE(tmltrd_bio(jpi,jpj,jpdiabio),         & 
    162                tmltrd_sum_bio(jpi,jpj,jpdiabio),     & 
    163                tmltrd_csum_ln_bio(jpi,jpj,jpdiabio), & 
    164                tmltrd_csum_ub_bio(jpi,jpj,jpdiabio), & 
    165                Stat=ierr(2)) 
     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) ) 
    166161# endif 
    167  
     162      ! 
    168163      trd_mod_trc_oce_alloc = MAXVAL(ierr) 
    169  
    170       IF( trd_mod_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_mod_trc_oce_alloc : failed to allocate arrays') 
    171  
     164      ! 
     165      IF( trd_mod_trc_oce_alloc /= 0 )   CALL ctl_warn('trd_mod_trc_oce_alloc: failed to allocate arrays') 
     166      ! 
    172167# if defined key_trdmld_trc 
    173168      jpktrd_trc = jpk      ! Initialise what used to be a parameter - max level for mixed-layer trends diag. 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r2643 r2690  
    1919   PUBLIC 
    2020 
    21    PUBLIC    trc_alloc          ! called by nemogcm.F90 
     21   PUBLIC   trc_alloc   ! called by nemogcm.F90 
    2222 
    2323   !! passive tracers names and units (read in namelist) 
    … …  
    3636   !! passive tracers fields (before,now,after) 
    3737   !! -------------------------------------------------- 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: cvol   !: volume correction -degrad option-  
    3938   REAL(wp), PUBLIC ::   trai                          !: initial total tracer 
    4039   REAL(wp), PUBLIC ::   areatot                       !: total volume  
    41  
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trn   !: traceur concentration for actual time step 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   tra   !: traceur concentration for next time step 
    44    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   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 
    4544 
    4645   !! interpolated gradient 
    4746   !!--------------------------------------------------   
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtru   !: horizontal gradient at u-points at bottom ocean level 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   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 
    5049    
    5150   !! passive tracers restart (input and output) 
    5251   !! ------------------------------------------   
    53    LOGICAL , PUBLIC          ::  ln_rsttr      !: boolean term for restart i/o for passive tracers (namelist) 
    54    LOGICAL , PUBLIC          ::  lrst_trc      !: logical to control the trc restart write 
    55    INTEGER , PUBLIC          ::  nn_dttrc      !: frequency of step on passive tracers 
    56    INTEGER , PUBLIC          ::  nutwrs        !: output FILE for passive tracers restart 
    57    INTEGER , PUBLIC          ::  nutrst        !: logical unit for restart FILE for passive tracers 
    58    INTEGER , PUBLIC          ::  nn_rsttr      !: control of the time step ( 0 or 1 ) for pass. tr. 
    59    CHARACTER(len=50), PUBLIC ::  cn_trcrst_in  !: suffix of pass. tracer restart name (input) 
    60    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) 
    6160    
    6261   !! information for outputs 
    … …  
    6867   !! additional 2D/3D outputs namelist 
    6968   !! -------------------------------------------------- 
    70    INTEGER , PUBLIC                               ::   nn_writedia   !: frequency of additional arrays outputs(namelist) 
    71    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2d      !: 2d output field name 
    72    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2u      !: 2d output field unit    
    73    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3d      !: 3d output field name 
    74    CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) ::   ctrc3u      !: 3d output field unit 
    75    CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) ::   ctrc2l      !: 2d output field long name 
    76    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 
    7776 
    78    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,  :) ::   trc2d    !:  additional 2d outputs   
    79    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trc3d    !:  additional 3d outputs   
     77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d    !:  additional 2d outputs   
     78   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d    !:  additional 3d outputs   
    8079# endif 
    8180 
    … …  
    9089   !! Biological trends 
    9190   !! ----------------- 
    92    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trbio   !: biological trends 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trbio   !: biological trends 
    9392# endif 
    9493 
    … …  
    101100 
    102101   !!---------------------------------------------------------------------- 
    103    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     102   !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 
    104103   !! $Id$  
    105    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     104   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    106105   !!---------------------------------------------------------------------- 
    107106CONTAINS 
    … …  
    114113      !!------------------------------------------------------------------- 
    115114      ! 
    116       ALLOCATE(cvol(jpi,jpj,jpk),                                  & 
    117                trn(jpi,jpj,jpk,jptra),                             & 
    118                tra(jpi,jpj,jpk,jptra),                             & 
    119                trb(jpi,jpj,jpk,jptra),                             & 
    120                gtru(jpi,jpj,jptra), gtrv(jpi,jpj,jptra),           & 
     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) ,     & 
    121120# if defined key_diatrc && ! defined key_iomput 
    122                trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 
     121         &      trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 
    123122# endif 
    124123# if defined key_diabio 
    125                trbio(jpi,jpj,jpk,jpdiabio),                        & 
     124         &      trbio(jpi,jpj,jpk,jpdiabio),                        & 
    126125#endif 
    127                rdttrc(jpk),  STAT=trc_alloc )       
     126               rdttrc(jpk) ,  STAT=trc_alloc )       
    128127 
    129128      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r2643 r2690  
    5757   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    5858   !! $Id$  
    59    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     59   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6060   !!---------------------------------------------------------------------- 
    6161CONTAINS 
    62  
    6362 
    6463   SUBROUTINE trc_dia( kt )   
    … …  
    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. 
    … …  
    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. 
    … …  
    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 
    … …  
    485483      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb ) 
    486484      ! 
    487  
    488485   END SUBROUTINE trcdib_wr 
    489486 
    … …  
    500497      !!                     ***  ROUTINE trc_dia_alloc  *** 
    501498      !!--------------------------------------------------------------------- 
    502  
    503499      ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=trc_dia_alloc ) 
    504  
    505       IF( trc_dia_alloc /= 0 ) CALL ctl_warn('trc_dia_alloc : failed to allocate arrays.') 
    506  
     500      ! 
     501      IF( trc_dia_alloc /= 0 )   CALL ctl_warn('trc_dia_alloc : failed to allocate arrays') 
     502      ! 
    507503   END FUNCTION trc_dia_alloc 
    508504#else 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r2649 r2690  
    2323   PRIVATE 
    2424 
    25    PUBLIC trc_dta         ! called in trcini.F90 and trcdmp.F90 
    26    PUBLIC trc_dta_alloc   ! called in nemogcm.F90 
     25   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90 
     26   PUBLIC   trc_dta_alloc   ! called in nemogcm.F90 
    2727 
    2828   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag 
    … …  
    3131   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   tracdta       ! tracer data at two consecutive times 
    3232   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nlectr      !: switch for reading once 
    33    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of first month when reading 12 monthly value 
    34    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of second month when reading 12 monthly value 
     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 
    3535 
    3636   !! * Substitutions 
    … …  
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    4040   !! $Id$  
    41    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4242   !!---------------------------------------------------------------------- 
    4343CONTAINS 
    … …  
    5656      !!      two monthly values. 
    5757      !!---------------------------------------------------------------------- 
    58       INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
     58      INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    5959      !! 
    6060      CHARACTER (len=39) ::   clname(jptra) 
    … …  
    199199   END SUBROUTINE trc_dta 
    200200 
     201 
    201202   INTEGER FUNCTION trc_dta_alloc() 
    202203      !!---------------------------------------------------------------------- 
    203204      !!                   ***  ROUTINE trc_dta_alloc  *** 
    204205      !!---------------------------------------------------------------------- 
    205  
    206       ALLOCATE(trdta(jpi,jpj,jpk,jptra),                   & 
    207                tracdta(jpi,jpj,jpk,jptra,2),               & 
    208                nlectr(jptra), ntrc1(jptra), ntrc2(jptra),  &  
    209                ! 
    210                STAT=trc_dta_alloc) 
    211  
    212       IF( trc_dta_alloc /= 0 ) CALL ctl_warn('trc_dta_alloc : failed to allocate arrays.') 
    213  
     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      ! 
    214212   END FUNCTION trc_dta_alloc 
    215213 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r2649 r2690  
    6464      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    6565 
    66  
    6766      CALL top_alloc()              ! allocate TOP arrays 
    68  
    6967 
    7068      !                             ! masked grid volume 
    … …  
    183181      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
    184182      !!---------------------------------------------------------------------- 
    185       ! 
    186183      USE trcadv        , ONLY:   trc_adv_alloc          ! TOP-related alloc routines... 
    187184      USE trc           , ONLY:   trc_alloc 
    … …  
    206203      ! 
    207204      ierr =        trc_adv_alloc()          ! Start of TOP-related alloc routines... 
    208       ierr = ierr + trc_alloc() 
     205      ierr = ierr + trc_alloc    () 
    209206      ierr = ierr + trc_nxt_alloc() 
    210207      ierr = ierr + trc_zdf_alloc() 
Note: See TracChangeset for help on using the changeset viewer.