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

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

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

First attempt to put dynamic allocation on the trunk

Location:
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES
Files:
15 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r2528 r2715  
    3232 
    3333   PUBLIC  p4z_bio     
    34  
    35    !! * Shared module variables 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    37       xnegtr            ! Array used to indicate negative tracer values 
    38  
    3934 
    4035   !!* Substitution 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r2567 r2715  
    1919   USE trc             ! TOP variables 
    2020   USE sms_pisces      ! sms trends 
    21    USE in_out_manager  ! I/O manager 
    2221 
    2322 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

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