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 2643 – NEMO

Changeset 2643


Ignore:
Timestamp:
2011-03-02T19:38:35+01:00 (13 years ago)
Author:
cetlod
Message:

Changed TOP/PISCES to use dynamic memory & improve the others TOP modules

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

Legend:

Unmodified
Added
Removed

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

    r2528 r2643  
    1717   USE trc             ! TOP variables 
    1818   USE trcsms_c14b     ! C14 sms trends 
    19    USE in_out_manager  ! I/O manager 
    2019 
    2120   IMPLICIT NONE 
    … …  
    5958      !!---------------------------------------------------------------------- 
    6059 
    61       !  Control consitency 
    62       CALL trc_ctl_c14b 
     60      CALL c14b_alloc()       ! Allocate CFC arrays 
     61 
     62      CALL trc_ctl_c14b     !  Control consitency 
    6363 
    6464      IF(lwp) WRITE(numout,*) '' 
    … …  
    164164 
    165165   END SUBROUTINE trc_ini_c14b 
     166 
     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 
    166179    
    167180   SUBROUTINE trc_ctl_c14b 

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

    r2567 r2643  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_c14b     ! C14b specific variable 
    18    USE in_out_manager  ! I/O manager 
    1918 
    2019   IMPLICIT NONE 

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

    r2528 r2643  
    1717   USE trc             ! TOP variables 
    1818   USE trcsms_c14b          ! c14b sms trends 
    19    USE in_out_manager  ! I/O manager 
    2019   USE iom 
    2120 

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

    r2633 r2643  
    6363CONTAINS 
    6464 
    65   FUNCTION trc_sms_c14b_alloc() 
    66      !!---------------------------------------------------------------------- 
    67      !!                  ***  ROUTINE trc_sms_c14b_alloc  *** 
    68      !!---------------------------------------------------------------------- 
    69      INTEGER :: trc_sms_c14b_alloc  ! Return value 
    70      !!---------------------------------------------------------------------- 
    71  
    72      ALLOCATE(fareaz(jpi,jpj ,jpzon), & 
    73               qtr_c14(jpi,jpj)      , & 
    74               qint_c14(jpi,jpj)     , Stat=trc_sms_c14b_alloc) 
    75  
    76      IF (trc_sms_c14b_alloc /= 0) CALL ctl_warn('trc_sms_c14b_alloc : failed to allocate arrays.') 
    77  
    78   END FUNCTION trc_sms_c14b_alloc 
    79  
    8065 
    8166  SUBROUTINE trc_sms_c14b( kt ) 
    … …  
    121106 
    122107     !! * Local declarations 
    123      INTEGER ::  & 
    124        ji, jj, jk, jz 
    125  
    126      INTEGER ::   & 
    127        iyear_beg,              & 
    128        iyear_beg1, iyear_end1, & 
    129        imonth1, im1, im2,      & 
    130        iyear_beg2, iyear_end2, & 
    131        imonth2, in1, in2 
     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  
    132114          
    133      REAL(wp), DIMENSION(jpzon)   ::  & 
    134        zonbc14              !: time interp atm C14 
    135  
    136      REAL(wp) ::     & 
    137        zpco2at              !: time interp atm C02 
    138  
    139      REAL(wp) ::     &      !: dummy variables 
    140        zt, ztp, zsk, & 
    141        zsol ,        &      !: solubility 
    142        zsch ,        &      !: schmidt number 
    143        zv2  ,        &      !: wind speed ( square) 
    144        zpv  ,        &      !: piston velocity  
    145        zdemi, ztra 
     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 
    146124      !!---------------------------------------------------------------------- 
    147125 
    148       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) )THEN 
     126      IF( ( wrk_in_use(2, 1) ) .OR. ( wrk_in_use(3, 1) ) ) THEN 
    149127         CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable.') 
    150128         RETURN 
    … …  
    331309      END IF 
    332310 
    333       IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )THEN 
    334          CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays.') 
    335       END IF 
     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.') 
    336313 
    337314    END SUBROUTINE trc_sms_c14b 
    338315 
     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 
    339328#else 
    340329    !!---------------------------------------------------------------------- 

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

    r2528 r2643  
    1515   USE par_trc         ! TOP parameters 
    1616   USE trc             ! TOP variables 
    17    USE trcsms_cfc          ! CFC sms trends 
    18    USE in_out_manager  ! I/O manager 
     17   USE trcsms_cfc      ! CFC sms trends 
    1918 
    2019   IMPLICIT NONE 
    … …  
    4544      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    4645      !!---------------------------------------------------------------------- 
    47       INTEGER  ::   ji, jj, jn, jl, jm, js 
    48       REAL(wp) ::   zyy  ,  zyd 
     46      INTEGER  ::  ji, jj, jn, jl, jm, js 
     47      REAL(wp) ::  zyy  ,  zyd 
    4948      !!---------------------------------------------------------------------- 
    5049 
    … …  
    5251      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model' 
    5352      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
     53 
     54      CALL cfc_alloc()       ! Allocate CFC arrays 
    5455 
    5556 
    … …  
    140141 
    141142   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 
    142156    
    143157#else 

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

    r2567 r2643  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_cfc      ! CFC specific variable 
    18    USE in_out_manager  ! I/O manager 
    1918 
    2019   IMPLICIT NONE 

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

    r2528 r2643  
    1717   USE trc             ! TOP variables 
    1818   USE trcsms_cfc          ! CFC sms trends 
    19    USE in_out_manager  ! I/O manager 
    2019   USE iom 
    2120 

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

    r2633 r2643  
    6060CONTAINS 
    6161 
    62    FUNCTION trc_sms_cfc_alloc() 
    63       !!---------------------------------------------------------------------- 
    64       !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
    65       !!---------------------------------------------------------------------- 
    66       INTEGER :: trc_sms_cfc_alloc 
    67       !!---------------------------------------------------------------------- 
    68  
    69       ALLOCATE(xphem(jpi,jpj),           & 
    70                qtr_cfc(jpi,jpj,jp_cfc),  & 
    71                qint_cfc(jpi,jpj,jp_cfc), & 
    72                Stat=trc_sms_cfc_alloc) 
    73  
    74       IF(trc_sms_cfc_alloc /= 0)THEN 
    75          CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
    76       END IF 
    77  
    78    END FUNCTION trc_sms_cfc_alloc 
    79  
    8062 
    8163   SUBROUTINE trc_sms_cfc( kt ) 
    … …  
    11597      !!---------------------------------------------------------------------- 
    11698 
    117       IF(wrk_in_use(3, 1))THEN 
     99      IF( wrk_in_use(3, 1) ) THEN 
    118100         CALL ctl_stop('trc_sms_cfc : requested workspace array unavailable.') 
    119101         RETURN 
    … …  
    202184#if defined key_diatrc  
    203185      ! Save diagnostics , just for CFC11 
    204 # if ! defined key_iomput 
     186# if  defined key_iomput 
     187      CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     188      CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     189# else 
    205190      trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    206191      trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    207 # else 
    208       CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    209       CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    210192# endif 
    211193#endif 
    … …  
    218200      END IF 
    219201 
    220       IF(wrk_not_released(3, 1))THEN 
    221          CALL ctl_stop('trc_sms_cfc : failed to release workspace array.') 
    222       END IF 
     202      IF( wrk_not_released(3, 1) ) CALL ctl_stop('trc_sms_cfc : failed to release workspace array.') 
    223203 
    224204   END SUBROUTINE trc_sms_cfc 
    … …  
    272252   END SUBROUTINE trc_cfc_cst 
    273253    
     254   INTEGER FUNCTION trc_sms_cfc_alloc() 
     255      !!---------------------------------------------------------------------- 
     256      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
     257      !!---------------------------------------------------------------------- 
     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 
     264      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
     265 
     266   END FUNCTION trc_sms_cfc_alloc 
     267 
    274268#else 
    275269   !!---------------------------------------------------------------------- 

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

    r2636 r2643  
    112112      !!        *** ROUTINE sms_lobster_alloc *** 
    113113      !!---------------------------------------------------------------------- 
    114       USE lib_mpp, ONLY: ctl_warn 
     114      USE lib_mpp, ONLY:   ctl_warn   ! MPP library 
     115      INTEGER :: ierr(3)        ! Local variables 
    115116      !!---------------------------------------------------------------------- 
    116       ! 
    117       ALLOCATE( remdmp(jpk,jp_lobster),                                   & 
    118          &      neln(jpi,jpj),    xze(jpi,jpj),     xpar(jpi,jpj,jpk),    & 
    119          &      dminl(jpi,jpj),   dmin3(jpi,jpj,jpk),                     & 
    120          &      sedpocb(jpi,jpj), sedpocn(jpi,jpj), sedpoca(jpi,jpj),     & 
    121          &      fbod(jpi,jpj),    cmask(jpi,jpj)                    , STAT=sms_lobster_alloc ) 
    122          ! 
    123       IF( sms_lobster_alloc /= 0 )   CALL ctl_warn('sms_lobster_alloc : failed to allocate arrays') 
    124       ! 
     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 
    125135   END FUNCTION sms_lobster_alloc 
    126136 

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

    r2633 r2643  
    8686 
    8787#if defined key_diatrc && defined key_iomput 
    88       IF( wrk_in_use(3, 2) .OR. wrk_in_use(4, 1) )THEN 
     88      IF( ( wrk_in_use(3, 2) ) .OR. ( wrk_in_use(4, 1) ) ) THEN 
    8989         CALL ctl_stop('trc_bio : requested workspace arrays unavailable.') 
    9090         RETURN 
    … …  
    103103      fbod(:,:) = 0.e0 
    104104#if defined key_diatrc && ! defined key_iomput 
     105#  if defined key_iomput 
     106      zw2d  (:,:,:) = 0.e0 
     107      zw3d(:,:,:,:) = 0.e0 
     108#  else 
    105109      DO jl = jp_lob0_2d, jp_lob1_2d 
    106110         trc2d(:,:,jl) = 0.e0 
    107111      END DO  
    108 #endif 
    109 #if defined key_diatrc && defined key_iomput 
    110       zw2d(:,:,:) = 0.e0 
    111       zw3d(:,:,:,:) = 0.e0 
     112#  endif 
    112113#endif 
    113114 
    … …  
    500501      ! 
    501502#if defined key_diatrc && defined key_iomput 
    502       IF( wrk_not_released(3, 2) .OR. wrk_not_released(4, 1) )THEN 
    503          CALL ctl_stop('trc_bio : failed to release workspace arrays.') 
    504       END IF 
     503      IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(4, 1) ) )  & 
     504        &   CALL ctl_stop('trc_bio : failed to release workspace arrays.') 
    505505#endif 
    506506      ! 

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

    r2528 r2643  
    101101            sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj)   & 
    102102               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
    103             zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj) 
     103            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1e2t(ji,jj) 
    104104         END DO 
    105105      END DO 

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

    r2633 r2643  
    2121   USE trc 
    2222   USE lbclnk  
    23    USE lib_mpp  
    24    USE lib_fortran  
    2523 
    2624   IMPLICIT NONE 
    … …  
    5048      !!---------------------------------------------------------------------- 
    5149 
    52       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) )THEN 
    53          CALL ctl_stop('trc_ini_lobster : requested workspace arrays unavailable.') 
    54          RETURN 
    55       END IF 
    56  
    57       !  Control consitency 
    58       CALL trc_ctl_lobster 
    59  
    60  
    6150      IF(lwp) WRITE(numout,*) 
    6251      IF(lwp) WRITE(numout,*) ' trc_ini_lobster :   LOBSTER biochemical model initialisation' 
    6352      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~' 
     53 
     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 
     60 
    6461 
    6562      ! initialization of fields for optical model 
    … …  
    144141      ! Coastal surface 
    145142      ! --------------- 
    146       areacot = glob_sum( e1t(:,:) * e2t(:,:) * cmask(:,:) ) 
     143      areacot = glob_sum( e1e2t(:,:) * cmask(:,:) ) 
    147144 
    148145      ! Initialization of tracer concentration in case of  no restart  
    … …  
    226223         trn(:,:,30,jp_lob_no3) = 20.01 * tmask(:,:,30) 
    227224 
    228 # elif defined key_gyre 
     225 
     226# elif defined key_gyre || defined key_orca_r2 
    229227         ! LOBSTER initialisation for GYRE 
    230228         ! ---------------------- 
    … …  
    259257      IF(lwp) WRITE(numout,*) ' ' 
    260258 
    261       IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )THEN 
    262          CALL ctl_stop('trc_ini_lobster : failed to release workspace arrays.') 
    263       END IF 
     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.') 
    264261 
    265262   END SUBROUTINE trc_ini_lobster 
    266263 
    267    SUBROUTINE trc_ctl_lobster 
    268       !!---------------------------------------------------------------------- 
    269       !!                     ***  ROUTINE trc_ctl_lobster  *** 
     264   SUBROUTINE lobster_alloc 
     265      !!---------------------------------------------------------------------- 
     266      !!                     ***  ROUTINE lobster_alloc  *** 
    270267      !! 
    271       !! ** Purpose :   control the cpp options, namelist and files  
    272       !!---------------------------------------------------------------------- 
    273       INTEGER :: jl, jn 
    274  
    275       IF(lwp) WRITE(numout,*) 
    276       IF(lwp) WRITE(numout,*) ' use LOBSTER biological model ' 
    277  
    278       ! Check number of tracers 
    279       ! ----------------------- 
    280       IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' ) 
    281  
    282       ! Check tracer names 
    283       ! ------------------ 
    284       IF(   ctrcnm(jp_lob_det) /= 'DET' .OR. ctrcnm(jp_lob_zoo) /= 'ZOO' .OR.   & 
    285          &  ctrcnm(jp_lob_phy) /= 'PHY' .OR. ctrcnm(jp_lob_no3) /= 'NO3' .OR.   & 
    286          &  ctrcnm(jp_lob_nh4) /= 'NH4' .OR. ctrcnm(jp_lob_dom) /= 'DOM' .OR.   & 
    287          &  ctrcnl(jp_lob_det) /= 'Detritus'                        .OR.   & 
    288          &  ctrcnl(jp_lob_zoo) /= 'Zooplankton concentration'       .OR.   & 
    289          &  ctrcnl(jp_lob_phy) /= 'Phytoplankton concentration'     .OR.   & 
    290          &  ctrcnl(jp_lob_no3) /= 'Nitrate concentration'           .OR.   & 
    291          &  ctrcnl(jp_lob_nh4) /= 'Ammonium concentration'          .OR.   & 
    292          &  ctrcnl(jp_lob_dom) /= 'Dissolved organic matter' ) THEN 
    293          ctrcnm(jp_lob_det)='DET' 
    294          ctrcnl(jp_lob_det)='Detritus' 
    295          ctrcnm(jp_lob_zoo)='ZOO' 
    296          ctrcnl(jp_lob_zoo)='Zooplankton concentration' 
    297          ctrcnm(jp_lob_phy)='PHY' 
    298          ctrcnl(jp_lob_phy)='Phytoplankton concentration' 
    299          ctrcnm(jp_lob_no3)='NO3' 
    300          ctrcnl(jp_lob_no3)='Nitrate concentration' 
    301          ctrcnm(jp_lob_nh4)='NH4' 
    302          ctrcnl(jp_lob_nh4)='Ammonium concentration' 
    303          ctrcnm(jp_lob_dom)='DOM' 
    304          ctrcnl(jp_lob_dom)='Dissolved organic matter' 
    305          IF(lwp) THEN 
    306             CALL ctl_warn( ' We force tracer names ' ) 
    307             DO jl = 1, jp_lobster 
    308                jn = jp_lob0 + jl - 1 
    309                WRITE(numout,*) ' tracer nb: ',jn,' name = ',ctrcnm(jn), ctrcnl(jn) 
    310             END DO 
    311             WRITE(numout,*) ' ' 
    312          ENDIF 
    313       ENDIF 
    314  
    315       ! Check tracer units 
    316       DO jl = 1, jp_lobster 
    317          jn = jp_lob0 + jl - 1 
    318          IF( ctrcun(jn) /= 'mmole-N/m3') THEN 
    319             ctrcun(jn) = 'mmole-N/m3' 
    320             IF(lwp) THEN 
    321                CALL ctl_warn( ' We force tracer units ' ) 
    322                WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
    323             ENDIF 
    324          ENDIF 
    325       END DO 
    326  
    327    END SUBROUTINE trc_ctl_lobster 
     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 
    328276 
    329277#else 

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

    r2636 r2643  
    1616   USE trc              ! TOP variables 
    1717   USE sms_lobster      ! sms trends 
    18    USE in_out_manager   ! I/O manager 
    19    USE lib_mpp          ! MPP library 
    2018 
    2119   IMPLICIT NONE 

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

    r2636 r2643  
    2121   USE sms_lobster 
    2222   USE prtctl_trc      ! Print control for debbuging 
    23    USE lib_mpp         ! MPP library 
    2423 
    2524   IMPLICIT NONE 
    … …  
    6968      !!--------------------------------------------------------------------- 
    7069 
    71       IF( (wrk_in_use(2, 1,2)) .OR. (wrk_in_use(3, 2,3)) )THEN 
     70      IF( ( wrk_in_use(2, 1,2)) .OR. ( wrk_in_use(3, 2,3)) )THEN 
    7271         CALL ctl_stop('trc_opt : requested workspace arrays unavailable')   ;   RETURN 
    7372      END IF 

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

    r2528 r2643  
    1818   USE trcsms_lobster          ! lobster sms trends 
    1919   USE sms_lobster          ! lobster sms trends 
    20    USE in_out_manager  ! I/O manager 
    2120   USE iom 
    2221 

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

    r2633 r2643  
    6969      !!--------------------------------------------------------------------- 
    7070 
    71       IF( (wrk_in_use(3,2)) .OR. (wrk_in_use(2,1)) )THEN 
     71      IF( ( wrk_in_use(3,2)) .OR. ( wrk_in_use(2,1)) ) THEN 
    7272         CALL ctl_stop('trc_sed : requested workspace arrays unavailable.') 
    7373         RETURN 
    … …  
    150150      ENDIF 
    151151 
    152       IF( (wrk_not_released(3,2)) .OR. (wrk_not_released(2,1)) )THEN 
    153          CALL ctl_stop('trc_sed : failed to release workspace arrays.') 
    154       END IF 
     152      IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(2, 1) ) )  & 
     153       &         CALL ctl_stop('trc_sed : failed to release workspace arrays.') 
    155154 
    156155   END SUBROUTINE trc_sed 

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

    r2636 r2643  
    2323   USE trdmod_trc 
    2424   USE trdmld_trc 
    25    USE lib_mpp          ! MPP library 
    2625 
    2726   IMPLICIT NONE 
    … …  
    5352      !! -------------------------------------------------------------------- 
    5453 
    55       IF( wrk_in_use(3,1) ) THEN 
     54      IF( wrk_in_use(3, 1) ) THEN 
    5655         CALL ctl_stop('trc_sms_lobster : requested workspace array unavailable')   ;   RETURN 
    5756      ENDIF 
    … …  
    7170      IF( lk_trdmld_trc )  CALL trd_mld_bio( kt )   ! trends: Mixed-layer 
    7271 
    73       IF( wrk_not_released(3,1) )   CALL ctl_stop('trc_sms_lobster : failed to release workspace array.') 
     72      IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_lobster : failed to release workspace array.') 
    7473      ! 
    7574   END SUBROUTINE trc_sms_lobster 

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

    r2528 r2643  
    3838      !!---------------------------------------------------------------------- 
    3939 
    40       !  Control consitency 
    41       CALL trc_ctl_my_trc 
     40      CALL my_trc_alloc()     ! Allocate MY_TRC arrays 
     41 
     42      CALL trc_ctl_my_trc     ! Control consitency 
    4243 
    4344      IF(lwp) WRITE(numout,*) 
    … …  
    6465      DO jl = 1, jp_my_trc 
    6566         jn = jp_myt0 + jl - 1 
    66          WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn 
     67         WRITE( ctrcnm(jn),'(a,i2.2)' ) 'CLR', jn 
    6768         ctrcnl(jn)='Color concentration' 
    6869         ctrcun(jn)='N/A' 
    … …  
    7172 
    7273   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 
    7385 
    7486#else 

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

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

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

    r2528 r2643  
    2525 
    2626   PUBLIC   p4z_che   
     27   PUBLIC   p4z_che_alloc   
    2728 
    2829   !! * 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 
     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 
    3433 
    3534   !! * Module variables 
    … …  
    156155CONTAINS 
    157156 
     157 
    158158   SUBROUTINE p4z_che 
    159159      !!--------------------------------------------------------------------- 
    … …  
    324324   END SUBROUTINE p4z_che 
    325325 
     326   INTEGER FUNCTION p4z_che_alloc() 
     327      !!---------------------------------------------------------------------- 
     328      !!                     ***  ROUTINE p4z_che_alloc  *** 
     329      !!---------------------------------------------------------------------- 
     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 
     336   END FUNCTION p4z_che_alloc 
    326337#else 
    327338   !!====================================================================== 

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

    r2528 r2643  
    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 
     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 
    4040   REAL(wp)                             ::  t_oce_co2_flx      !: Total ocean carbon flux  
    4141   REAL(wp)                             ::  t_atm_co2_flx      !: global mean of atmospheric pco2 
    … …  
    6363      !! ** Method  : - ??? 
    6464      !!--------------------------------------------------------------------- 
     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      ! 
    6570      INTEGER, INTENT(in) :: kt 
    6671      INTEGER  ::   ji, jj, jrorr 
    … …  
    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 
    7576 
    7677      !!--------------------------------------------------------------------- 
     78 
     79      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 
    7782 
    7883      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
    … …  
    149154            zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    150155            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. 
     156            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    153157            ! compute the trend 
    154158            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
    … …  
    162166            ! Save diagnostics 
    163167#  if ! defined key_iomput 
    164             zfact = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) / rfact 
     168            zfact = 1. / e1e2t(ji,jj) / rfact 
    165169            trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact 
    166170            trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    … …  
    180184      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon 
    181185      IF( kt == nitend ) THEN 
    182          t_atm_co2_flx = glob_sum( satmco2(:,:) * e1t(:,:) * e2t(:,:) )            ! Total atmospheric pCO2 
     186         t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2 
    183187         ! 
    184188         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15                      ! Conversion in PgC ; negative for out of the ocean 
    … …  
    203207 
    204208# if defined key_diatrc && defined key_iomput 
    205       CALL iom_put( "Cflx" , oce_co2(:,:) / ( e1t(:,:) * e2t(:,:) ) / rfact  ) 
     209      CALL iom_put( "Cflx" , oce_co2(:,:) /  e1e2t(:,:) / rfact   
    206210      CALL iom_put( "Oflx" , zoflx  ) 
    207211      CALL iom_put( "Kg"   , zkg    ) 
    … …  
    210214#endif 
    211215 
     216      IF( wrk_not_released(2, 1,2,3,4,5,6,7) ) CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
     217      ! 
    212218   END SUBROUTINE p4z_flx 
    213219 
    … …  
    238244 
    239245      ! interior global domain surface 
    240       area = glob_sum( e1t(:,:) * e2t(:,:) )   
     246      area = glob_sum( e1e2t(:,:) )   
    241247 
    242248      ! Initialization of Flux of Carbon 
    … …  
    249255   END SUBROUTINE p4z_flx_init 
    250256 
     257   INTEGER FUNCTION p4z_flx_alloc() 
     258      !!---------------------------------------------------------------------- 
     259      !!                     ***  ROUTINE p4z_flx_alloc  *** 
     260      !!---------------------------------------------------------------------- 
     261 
     262      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 
     266   END FUNCTION p4z_flx_alloc 
     267 
    251268#else 
    252269   !!====================================================================== 

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

    r2528 r2643  
    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 
    2828   !! * Module variables 
    29    REAL(wp) :: & 
    30       xksilim = 16.5E-6        ! Half-saturation constant for the computation of the Si half-saturation constant 
     29   REAL(wp) :: xksilim = 16.5E-6   ! Half-saturation constant for the computation of the Si half-saturation constant 
    3130 
    3231 
    … …  
    7675   END SUBROUTINE p4z_int 
    7776 
     77   INTEGER FUNCTION p4z_int_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      !!                     ***  ROUTINE p4z_int_alloc  *** 
     80      !!---------------------------------------------------------------------- 
     81 
     82      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 
     86   END FUNCTION p4z_int_alloc 
     87 
    7888#else 
    7989   !!====================================================================== 

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

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

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

    r2528 r2643  
    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 
     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 
    2930 
    3031   INTEGER  ::  nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    … …  
    4344CONTAINS 
    4445 
     46 
    4547   SUBROUTINE p4z_opt( kt, jnt ) 
    4648      !!--------------------------------------------------------------------- 
    … …  
    5254      !! ** Method  : - ??? 
    5355      !!--------------------------------------------------------------------- 
     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      ! 
    5462      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    5563      INTEGER  ::   ji, jj, jk 
    … …  
    5765      REAL(wp) ::   zchl, zxsi0r 
    5866      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 
    6267      !!--------------------------------------------------------------------- 
    6368 
     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 
    6472 
    6573      !     Initialisation of variables used to compute PAR 
    … …  
    223231#endif 
    224232      ! 
     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') 
     235      ! 
    225236   END SUBROUTINE p4z_opt 
    226237 
    … …  
    245256      !  
    246257   END SUBROUTINE p4z_opt_init 
     258 
     259   INTEGER FUNCTION p4z_opt_alloc() 
     260      !!---------------------------------------------------------------------- 
     261      !!                     ***  ROUTINE p4z_opt_alloc  *** 
     262      !!---------------------------------------------------------------------- 
     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 
     267      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 
     268 
     269   END FUNCTION p4z_opt_alloc 
     270 
    247271#else 
    248272   !!---------------------------------------------------------------------- 

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

    r2528 r2643  
    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 
     29   PUBLIC   p4z_prod_alloc 
    3230 
    3331   !! * Shared module variables 
    … …  
    4341     grosip    = 0.151_wp 
    4442 
    45    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk)  ::  prmax  
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax 
    4644    
    4745   REAL(wp) ::   & 
    … …  
    6159CONTAINS 
    6260 
     61 
    6362   SUBROUTINE p4z_prod( kt , jnt ) 
    6463      !!--------------------------------------------------------------------- 
    … …  
    7069      !! ** Method  : - ??? 
    7170      !!--------------------------------------------------------------------- 
     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 
     79      ! 
    7280      INTEGER, INTENT(in) :: kt, jnt 
    7381      INTEGER  ::   ji, jj, jk 
    … …  
    8189      REAL(wp) ::   zrfact2 
    8290#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 
    8991      CHARACTER (len=25) :: charout 
    9092      !!--------------------------------------------------------------------- 
     93 
     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 
    9197 
    9298      zprorca (:,:,:) = 0.0 
    … …  
    187193                  zsilfac = MIN( 6.4,zsilfac * zsilfac2) 
    188194                  zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 
    189  
    190195              ENDIF 
    191196            END DO 
    … …  
    363368       ENDIF 
    364369 
     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') 
     372      ! 
    365373   END SUBROUTINE p4z_prod 
    366374 
    … …  
    408416 
    409417 
     418   INTEGER FUNCTION p4z_prod_alloc() 
     419      !!---------------------------------------------------------------------- 
     420      !!                     ***  ROUTINE p4z_prod_alloc  *** 
     421      !!---------------------------------------------------------------------- 
     422 
     423      ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 
     424 
     425      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 
     426 
     427   END FUNCTION p4z_prod_alloc 
    410428 
    411429#else 

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

    r2528 r2643  
    2929   PUBLIC   p4z_rem         ! called in p4zbio.F90 
    3030   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90 
     31   PUBLIC   p4z_rem_alloc 
    3132 
    3233   !! * Shared module variables 
    … …  
    3940     oxymin  = 1.e-6_wp         !: 
    4041 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::    & !: 
    42      &                   denitr                     !: denitrification array 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr  !: denitrification array 
    4343 
    4444 
    … …  
    5353CONTAINS 
    5454 
     55 
    5556   SUBROUTINE p4z_rem( kt ) 
    5657      !!--------------------------------------------------------------------- 
    … …  
    6162      !! ** Method  : - ??? 
    6263      !!--------------------------------------------------------------------- 
     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 
     67      ! 
    6368      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6469      INTEGER  ::   ji, jj, jk 
    … …  
    7277#endif 
    7378      REAL(wp) ::   zlamfac, zonitr, zstep 
    74       REAL(wp), DIMENSION(jpi,jpj)     ::   ztempbac 
    75       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepbac, zfesatur, zolimi 
    7679      CHARACTER (len=25) :: charout 
    7780 
    7881      !!--------------------------------------------------------------------- 
    7982 
     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 
    8086 
    8187       ! Initialisation of temprary arrys 
    … …  
    393399       ENDIF 
    394400 
     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 
    395404   END SUBROUTINE p4z_rem 
    396405 
    … …  
    431440   END SUBROUTINE p4z_rem_init 
    432441 
     442   INTEGER FUNCTION p4z_rem_alloc() 
     443      !!---------------------------------------------------------------------- 
     444      !!                     ***  ROUTINE p4z_rem_alloc  *** 
     445      !!---------------------------------------------------------------------- 
     446 
     447      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 
     451   END FUNCTION p4z_rem_alloc 
    433452#else 
    434453   !!====================================================================== 

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

    r2528 r2643  
    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   !!====================================================================== 

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

    r2528 r2643  
    2121   PUBLIC   p4z_sink         ! called in p4zbio.F90 
    2222   PUBLIC   p4z_sink_init    ! called in trcsms_pisces.F90 
     23   PUBLIC   p4z_sink_alloc 
    2324 
    2425   !! * 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 
     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 
    2829 
    2930   !! * 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              ! 
     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 
     35#if ! defined key_kriest 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sinkfer2           !: Big iron sinking fluxes 
     37#endif 
     38 
     39   INTEGER  :: iksed  = 10 
    3740 
    3841#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  
     42   REAL(wp) ::  xkr_sfact    = 250.     !: Sinking factor 
     43   REAL(wp) ::  xkr_stick    = 0.2      !: Stickiness 
     44   REAL(wp) ::  xkr_nnano    = 2.337    !: Nbr of cell in nano size class 
     45   REAL(wp) ::  xkr_ndiat    = 3.718    !: Nbr of cell in diatoms size class 
     46   REAL(wp) ::  xkr_nmeso    = 7.147    !: Nbr of cell in mesozoo  size class 
     47   REAL(wp) ::  xkr_naggr    = 9.877    !: Nbr of cell in aggregates  size class 
     48 
     49   REAL(wp) ::  xkr_frac  
     50 
     51   REAL(wp), PUBLIC ::  xkr_dnano       !: Size of particles in nano pool 
     52   REAL(wp), PUBLIC ::  xkr_ddiat       !: Size of particles in diatoms pool 
     53   REAL(wp), PUBLIC ::  xkr_dmeso       !: Size of particles in mesozoo pool 
     54   REAL(wp), PUBLIC ::  xkr_daggr       !: Size of particles in aggregates pool 
     55   REAL(wp), PUBLIC ::  xkr_wsbio_min   !: min vertical particle speed 
     56   REAL(wp), PUBLIC ::  xkr_wsbio_max   !: max vertical particle speed 
     57 
     58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: xnumm  !:  maximum number of particles in aggregates 
     59#endif 
    6760 
    6861   !!* Substitution 
    … …  
    7669CONTAINS 
    7770 
     71 
    7872#if defined key_kriest 
    7973 
    … …  
    8781      !! ** Method  : - ??? 
    8882      !!--------------------------------------------------------------------- 
    89  
     83      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     84      USE wrk_nemo, ONLY: znum3d    => wrk_3d_2 
    9085      INTEGER, INTENT(in) :: kt, jnt 
    9186      INTEGER  :: ji, jj, jk 
    … …  
    9994      INTEGER  :: ik1 
    10095#endif 
    101       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znum3d 
    10296      CHARACTER (len=25) :: charout 
    10397 
    10498      !!--------------------------------------------------------------------- 
    10599 
     100      IF( wrk_in_use(3, 2 ) ) THEN 
     101         CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')  ;  RETURN 
     102      END IF 
    106103      !     Initialisation of variables used to compute Sinking Speed 
    107104      !     --------------------------------------------------------- 
    … …  
    311308       ENDIF 
    312309 
     310      IF( wrk_not_released(3, 2 ) ) CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
     311      ! 
    313312   END SUBROUTINE p4z_sink 
    314313 
    … …  
    611610      !!      transport term, i.e.  div(u*tra). 
    612611      !!--------------------------------------------------------------------- 
     612      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     613      USE wrk_nemo, ONLY: ztraz => wrk_3d_2, zakz => wrk_3d_3, zwsink2 => wrk_3d_4 
     614      ! 
    613615      INTEGER , INTENT(in   )                         ::   jp_tra    ! tracer index index       
    614616      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pwsink    ! sinking speed 
    … …  
    617619      INTEGER  ::   ji, jj, jk, jn 
    618620      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  
     621      !!--------------------------------------------------------------------- 
     622 
     623      IF(  wrk_in_use(3, 2,3,4 ) ) THEN 
     624         CALL ctl_stop('p4z_sink2: requested workspace arrays unavailable') 
     625         RETURN 
     626      END IF 
    623627 
    624628      zstep = rfact2 / 2. 
    … …  
    704708      psinkflx(:,:,:)   = 2. * psinkflx(:,:,:) 
    705709 
     710      IF( wrk_not_released(3, 2,3,4 ) ) CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 
    706711      ! 
    707712   END SUBROUTINE p4z_sink2 
    708713 
     714   INTEGER FUNCTION p4z_sink_alloc() 
     715      !!---------------------------------------------------------------------- 
     716      !!                     ***  ROUTINE p4z_sink_alloc  *** 
     717      !!---------------------------------------------------------------------- 
     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)                  ,  &                 
     722#if defined key_kriest 
     723        &       xnumm(jpk)                                                  ,  &                 
     724#else 
     725        &       sinkfer2(jpi,jpj,jpk)                                       ,  &                 
     726#endif 
     727 
     728        &       sinkfer(jpi,jpj,jpk), STAT=p4z_sink_alloc )                 
     729 
     730      IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 
     731 
     732   END FUNCTION p4z_sink_alloc 
    709733#else 
    710734   !!====================================================================== 

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

    r2528 r2643  
    3838   !!* Damping  
    3939   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
    40                                    !: when initialize from a restart file  
    4140   LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
    4241                                   !: on close seas 
    4342 
    4443   !!*  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 
     44   INTEGER , ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  neln       !: number of T-levels + 1 in the euphotic layer 
     45   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::  heup       !: euphotic layer depth 
    4746 
    4847   !!*  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    !: ??? 
     48   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksi       !: ??? 
     49   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksimax    !: ??? 
     50   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnanono3   !: ??? 
     51   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiatno3   !: ??? 
     52   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnanonh4   !: ??? 
     53   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiatnh4   !: ??? 
     54   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimphy    !: ??? 
     55   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimdia    !: ??? 
     56   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   concdfe    !: ??? 
     57   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   concnfe    !: ??? 
    5958 
    6059   !!*  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      !: ?? 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xfracal    !: ?? 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ?? 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ?? 
     63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ?? 
    6564#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 
     65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
     66   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing 
    6867#endif 
    6968 
    7069   !!* 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         !: ??? 
     70   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ??? 
     71   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak13       !: ??? 
     72   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak23       !: ??? 
     73   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksp       !: ??? 
     74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ??? 
     75   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
     76   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ??? 
     77 
     78   !!* Array used to indicate negative tracer values 
     79   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xnegtr     !: ??? 
    7880 
    7981#if defined key_kriest 
    … …  
    8486   REAL(wp) ::   xkr_mass_min, xkr_mass_max         !: ??? 
    8587#endif 
     88 
     89CONTAINS 
     90 
     91   INTEGER FUNCTION sms_pisces_alloc() 
     92      !!---------------------------------------------------------------------- 
     93      !!        *** ROUTINE sms_pisces_alloc *** 
     94      !!---------------------------------------------------------------------- 
     95      USE lib_mpp , ONLY: ctl_warn 
     96      INTEGER :: ierr(5)        ! Local variables 
     97      !!---------------------------------------------------------------------- 
     98 
     99      ierr(:) = 0 
     100 
     101      !*  Biological fluxes for light 
     102      ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                           STAT=ierr(1) ) 
     103 
     104      !*  Biological fluxes for primary production 
     105      ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,               & 
     106         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),               & 
     107         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),               & 
     108         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),               & 
     109         &      concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk),           STAT=ierr(2) )  
     110 
     111      !*  SMS for the organic matter 
     112      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk),               & 
     113#if defined key_diatrc 
     114         &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk) ,               & 
     115#endif  
     116         &      xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk)   ,           STAT=ierr(3) )   
     117 
     118      !* Variable for chemistry of the CO2 cycle 
     119      ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) ,                      & 
     120         &      ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) ,                      & 
     121         &      akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 
     122 
     123      !* Array used to indicate negative tracer values   
     124      ALLOCATE( xnegtr(jpi,jpj,jpk),                                    STAT=ierr(5) ) 
     125 
     126      sms_pisces_alloc = MAXVAL( ierr ) 
     127 
     128      IF( sms_pisces_alloc /= 0 ) CALL ctl_warn('sms_pisces_alloc : failed to allocate arrays.')  
     129 
     130   END FUNCTION sms_pisces_alloc 
    86131 
    87132#else 

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

    r2528 r2643  
    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 
    … …  
    2935 
    3036   !! * 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 
     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 
    3944 
    4045#  include "top_substitute.h90" 
    … …  
    5560 
    5661 
    57       !  Control consitency 
    58       CALL trc_ctl_pisces 
    59  
    60  
    6162      IF(lwp) WRITE(numout,*) 
    6263      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
    6364      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     65 
     66 
     67      CALL pisces_alloc()                          ! Allocate PISCES arrays 
    6468 
    6569      !                                            ! Time-step 
    … …  
    129133      ! 
    130134   END SUBROUTINE trc_ini_pisces 
    131   
    132    SUBROUTINE trc_ctl_pisces 
     135 
     136   SUBROUTINE pisces_alloc 
    133137      !!---------------------------------------------------------------------- 
    134       !!                     ***  ROUTINE trc_ctl_pisces  *** 
     138      !!                     ***  ROUTINE pisces_alloc  *** 
    135139      !! 
    136       !! ** Purpose :   control the cpp options, namelist and files  
     140      !! ** Purpose :   Allocate all the dynamic arrays of PISCES  
    137141      !!---------------------------------------------------------------------- 
     142      USE p4zint , ONLY : p4z_int_alloc       
     143      USE p4zsink, ONLY : p4z_sink_alloc       
     144      USE p4zopt , ONLY : p4z_opt_alloc            
     145      USE p4zprod, ONLY : p4z_prod_alloc          
     146      USE p4zrem , ONLY : p4z_rem_alloc            
     147      USE p4zsed , ONLY : p4z_sed_alloc           
     148      USE p4zflx , ONLY : p4z_flx_alloc 
     149      ! 
     150      INTEGER :: ierr 
     151      !!---------------------------------------------------------------------- 
     152      ! 
     153      ierr =         sms_pisces_alloc()          ! Start of PISCES-related alloc routines... 
     154      ierr = ierr +     p4z_che_alloc() 
     155      ierr = ierr +     p4z_int_alloc() 
     156      ierr = ierr +    p4z_sink_alloc() 
     157      ierr = ierr +     p4z_opt_alloc() 
     158      ierr = ierr +    p4z_prod_alloc() 
     159      ierr = ierr +     p4z_rem_alloc() 
     160      ierr = ierr +     p4z_sed_alloc() 
     161      ierr = ierr +     p4z_flx_alloc() 
     162      ! 
     163      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     164      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'pisces_alloc : unable to allocate PISCES arrays' ) 
    138165 
    139       IF(lwp) WRITE(numout,*) 
    140       IF(lwp) WRITE(numout,*) ' use PISCES biological model ' 
     166      ! 
     167   END SUBROUTINE pisces_alloc 
    141168 
    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    
    152169#else 
    153170   !!---------------------------------------------------------------------- 

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

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

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

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

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

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

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90

    r2528 r2643  
    1717   USE sedarr 
    1818   USE iom 
    19    USE in_out_manager  ! I/O manager 
    2019 
    2120 

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

    r2636 r2643  
    2525   USE traadv_eiv      ! eddy induced velocity     (tra_adv_eiv    routine) 
    2626   USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_mpp         ! MPP library 
    2927   USE prtctl_trc      ! Print control 
    3028 
    … …  
    5048CONTAINS 
    5149 
    52    FUNCTION trc_adv_alloc() 
     50   INTEGER FUNCTION trc_adv_alloc() 
    5351      !!---------------------------------------------------------------------- 
    5452      !!                  ***  ROUTINE trc_adv_alloc  *** 
    5553      !!---------------------------------------------------------------------- 
    56       INTEGER :: trc_adv_alloc 
    57       !!---------------------------------------------------------------------- 
    58  
    59       ALLOCATE(r2dt(jpk), Stat=trc_adv_alloc) 
    60  
    61       IF(trc_adv_alloc /= 0)THEN 
    62          CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    63       END IF 
     54 
     55      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc ) 
     56 
     57      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.') 
    6458 
    6559   END FUNCTION trc_adv_alloc 
    … …  
    7569      !!---------------------------------------------------------------------- 
    7670      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    77       USE wrk_nemo, ONLY: zun => wrk_3d_1, zvn => wrk_3d_2, & 
    78                           zwn => wrk_3d_3   ! effective velocity 
     71      USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, & 
     72                          zwn => wrk_3d_6   ! effective velocity 
    7973      !! 
    8074      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    8478      !!---------------------------------------------------------------------- 
    8579 
    86       IF(wrk_in_use(3, 1,2,3))THEN 
     80      IF( wrk_in_use(3, 4,5,6) ) THEN 
    8781         CALL ctl_stop('trc_adv : requested workspace arrays unavailable.') 
    8882         RETURN 
    … …  
    10498      DO jk = 1, jpkm1 
    10599         !                                                ! eulerian transport only 
    106          zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 
    107          zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
    108          zwn(:,:,jk) = e1t(:,:) * e2t(:,:)      * wn(:,:,jk) 
     100         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk) 
     101         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 
     102         zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    109103         ! 
    110104      END DO 
    … …  
    150144      END IF 
    151145      ! 
    152       IF(wrk_not_released(3, 1,2,3))THEN 
    153          CALL ctl_stop('trc_adv : failed to release workspace arrays.') 
    154       END IF 
     146      IF( wrk_not_released(3, 4,5,6) ) CALL ctl_stop('trc_adv : failed to release workspace arrays.') 
    155147      ! 
    156148   END SUBROUTINE trc_adv 

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

    r2528 r2643  
    2727   USE trdtra 
    2828   USE prtctl_trc      ! Print control 
    29    USE in_out_manager  ! I/O manager 
    30    USE lib_mpp         ! distribued memory computing library 
    31    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3229 
    3330   IMPLICIT NONE 

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

    r2636 r2643  
    5757      !!                   ***  ROUTINE trc_nxt_alloc  *** 
    5858      !!---------------------------------------------------------------------- 
    59       USE lib_mpp, ONLY: ctl_warn 
    60       !!---------------------------------------------------------------------- 
    6159      ! 
    62       ALLOCATE( r2dt(jpk), Stat=trc_nxt_alloc) 
     60      ALLOCATE( r2dt(jpk), STAT=trc_nxt_alloc) 
    6361      ! 
    6462      IF( trc_nxt_alloc /= 0 )   CALL ctl_warn('trc_nxt_alloc : failed to allocate array') 

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

    r2528 r2643  
    1717   USE trdmod_oce 
    1818   USE trdtra 
    19    USE lib_mpp 
    2019   USE prtctl_trc          ! Print control for debbuging 
    2120 

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

    r2636 r2643  
    2121   USE trdmod_oce 
    2222   USE trdtra 
    23    USE lib_mpp         ! MPP library 
    2423 
    2524   IMPLICIT NONE 
    … …  
    5958      !!---------------------------------------------------------------------- 
    6059      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    61       USE wrk_nemo, zemps => wrk_2d_1 
     60      USE wrk_nemo, zemps  => wrk_2d_1 
     61      USE wrk_nemo, ztrtrd => wrk_3d_1 
    6262      ! 
    6363      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    … …  
    6565      INTEGER  ::   ji, jj, jn           ! dummy loop indices 
    6666      REAL(wp) ::   zsrau, zse3t   ! temporary scalars 
    67       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    6867      CHARACTER (len=22) :: charout 
    6968      !!---------------------------------------------------------------------- 
    7069 
    71       IF(wrk_in_use(2, 1))THEN 
     70      IF( wrk_in_use(2, 1) .OR.  wrk_in_use(3, 1) ) THEN 
    7271         CALL ctl_stop('trc_sbc: requested workspace array unavailable.')   ;   RETURN 
    7372      END IF 
    … …  
    7978      ENDIF 
    8079 
    81  
    82       IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    8380 
    8481      IF( lk_offline ) THEN          ! emps in dynamical files contains emps - rnf 
    … …  
    115112      END DO                                                     ! tracer loop 
    116113      !                                                          ! =========== 
    117       IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 
    118  
    119114      IF( ln_ctl )   THEN 
    120115         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
    … …  
    122117      ENDIF 
    123118 
    124       IF( wrk_not_released(2, 1) )   CALL ctl_stop('trc_sbc: failed to release workspace array') 
    125       ! 
     119      IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )   & 
     120      &       CALL ctl_stop('trc_sbc: failed to release workspace array.') 
     121 
    126122   END SUBROUTINE trc_sbc 
    127123 

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

    r2636 r2643  
    2323   USE trdtra 
    2424   USE prtctl_trc      ! Print control 
    25    USE in_out_manager  ! I/O manager 
    26    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    27    USE lib_mpp         ! MPP library 
    2825 
    2926   IMPLICIT NONE 

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

    r2636 r2643  
    244244      !!---------------------------------------------------------------------- 
    245245 
    246       IF(wrk_in_use(2, 1))THEN 
    247          CALL ctl_stop('trd_mld_bio_zint : requested workspace array unavailable.') 
    248          RETURN 
     246      IF( wrk_in_use(2, 1) ) THEN 
     247         CALL ctl_stop('trd_mld_bio_zint : requested workspace array unavailable.') ; RETURN 
    249248      END IF 
    250249 
    … …  
    329328      END DO 
    330329 
    331       IF(wrk_not_released(2, 1))THEN 
    332          CALL ctl_stop('trd_mld_bio_zint : failed to release workspace array.') 
    333       END IF 
     330      IF( wrk_not_released(2, 1) ) CALL ctl_stop('trd_mld_bio_zint : failed to release workspace array.') 
    334331#endif 
    335332 
    … …  
    912909      IF( lrst_trc )   CALL trd_mld_trc_rst_write( kt )  ! this must be after the array swap above (III.3) 
    913910 
    914       IF(wrk_not_released(3, 1,2,3,4,5,6,7,8,9))THEN 
    915          CALL ctl_stop('trd_mld_trc : failed to release workspace arrays.') 
    916       END IF 
     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.') 
    917913      ! 
    918914   END SUBROUTINE trd_mld_trc 

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

    r2636 r2643  
    116116      tmltrd_csum_ub_bio                         !: before (prev. analysis period) cumulated sum over the 
    117117                                                 !: upper triangle 
    118 # endif 
     118#endif 
     119 
    119120   !!---------------------------------------------------------------------- 
    120121   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    155156               tmltrdm_trc(jpi,jpj,jptra),                   & 
    156157               Stat=ierr(1)) 
    157 # endif 
     158#endif 
     159 
    158160# if defined key_lobster 
    159161      ALLOCATE(tmltrd_bio(jpi,jpj,jpdiabio),         & 

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

    r2528 r2643  
    3333   !* IO manager * 
    3434   USE in_out_manager     
    35                            
     35  
     36   !* MPP library                          
     37   USE lib_mpp  
     38 
     39   !* Fortran utilities                          
     40   USE lib_fortran 
     41 
    3642   !* physical constants * 
    3743   USE phycst             
    … …  
    8894   USE dom_oce , ONLY :   e1t        =>   e1t        !: horizontal scale factors at t-point (m)   
    8995   USE dom_oce , ONLY :   e2t        =>   e2t        !: horizontal scale factors at t-point (m)    
     96   USE dom_oce , ONLY :   e1e2t      =>   e1e2t      !: cell surface at t-point (m2) 
    9097   USE dom_oce , ONLY :   e1u        =>   e1u        !: horizontal scale factors at u-point (m) 
    9198   USE dom_oce , ONLY :   e2u        =>   e2u        !: horizontal scale factors at u-point (m) 
    … …  
    194201 
    195202#endif 
    196    USE lib_mpp , ONLY :   lk_mpp    =>  lk_mpp        !: Mpp flag 
    197203 
    198204   USE dom_oce , ONLY :   nn_cla    =>  nn_cla        !: flag (0/1) for cross land advection  

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

    r2633 r2643  
    1717   USE par_trc          ! TOP parameters 
    1818   USE oce_trc          ! ocean space and time domain variables 
    19    USE in_out_manager   ! I/O manager 
    20    USE lib_mpp          ! distributed memory computing 
    2119 
    2220   IMPLICIT NONE 
    … …  
    7876      !!---------------------------------------------------------------------- 
    7977 
    80       IF(wrk_in_use(3, 1,2))THEN 
     78      IF( wrk_in_use(3, 1,2) ) THEN 
    8179         CALL ctl_stop('prt_ctl_trc : requested workspace arrays unavailable.') 
    8280         RETURN 
    … …  
    158156      END DO 
    159157      ! 
    160       IF(wrk_not_released(3, 1,2))THEN 
    161          CALL ctl_stop('prt_ctl_trc : failed to release workspace arrays.') 
    162       END IF 
     158      IF( wrk_not_released(3, 1,2) ) CALL ctl_stop('prt_ctl_trc : failed to release workspace arrays.') 
    163159      ! 
    164160   END SUBROUTINE prt_ctl_trc 

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

    r2636 r2643  
    119119               trb(jpi,jpj,jpk,jptra),                             & 
    120120               gtru(jpi,jpj,jptra), gtrv(jpi,jpj,jptra),           & 
    121                rdttrc(jpk),                                        & 
    122121# if defined key_diatrc && ! defined key_iomput 
    123122               trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 
    … …  
    125124# if defined key_diabio 
    126125               trbio(jpi,jpj,jpk,jpdiabio),                        & 
    127 # endif 
    128                STAT=trc_alloc) 
     126#endif 
     127               rdttrc(jpk),  STAT=trc_alloc )       
    129128 
    130129      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 
    131130      ! 
    132131   END FUNCTION trc_alloc 
    133     
     132 
    134133#else 
    135134   !!---------------------------------------------------------------------- 

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

    r2593 r2643  
    2525   USE par_trc 
    2626   USE dianam    ! build name of file (routine) 
    27    USE in_out_manager  ! I/O manager 
    28    USE lib_mpp 
    2927   USE ioipsl 
    3028 
    … …  
    6361CONTAINS 
    6462 
    65    FUNCTION trc_dia_alloc() 
    66       !!--------------------------------------------------------------------- 
    67       !!                     ***  ROUTINE trc_dia_alloc  *** 
    68       !!--------------------------------------------------------------------- 
    69       INTEGER :: trc_dia_alloc 
    70       !!--------------------------------------------------------------------- 
    71  
    72       ALLOCATE(ndext50(jpij*jpk), ndext51(jpij), Stat=trc_dia_alloc) 
    73  
    74       IF(trc_dia_alloc /= 0)THEN 
    75          CALL ctl_warn('trc_dia_alloc : failed to allocate arrays.') 
    76       END IF 
    77  
    78    END FUNCTION trc_dia_alloc 
    79  
    8063 
    8164   SUBROUTINE trc_dia( kt )   
    … …  
    200183         DO jn = 1, jptra 
    201184            IF( lutsav(jn) ) THEN 
    202                cltra  = ctrcnm(jn)   ! short title for tracer 
    203                cltral = ctrcnl(jn)   ! long title for tracer 
    204                cltrau = ctrcun(jn)   ! UNIT for tracer 
     185               cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
     186               cltral = TRIM( ctrcnl(jn) )   ! long title for tracer 
     187               cltrau = TRIM( ctrcun(jn) )   ! UNIT for tracer 
    205188               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  & 
    206189                  &          ipk, 1, ipk,  ndepit5, 32, clop, zsto, zout )  
    … …  
    225208 
    226209      DO jn = 1, jptra 
    227          cltra = ctrcnm(jn)      ! short title for tracer 
     210         cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
    228211         IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
    229212      END DO 
    … …  
    325308         ! more 3D horizontal arrays 
    326309         DO jl = 1, jpdia3d 
    327             cltra  = ctrc3d(jl)   ! short title for 3D diagnostic 
    328             cltral = ctrc3l(jl)   ! long title for 3D diagnostic 
    329             cltrau = ctrc3u(jl)   ! UNIT for 3D diagnostic 
     310            cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic 
     311            cltral = TRIM( ctrc3l(jl) )  ! long title for 3D diagnostic 
     312            cltrau = TRIM( ctrc3u(jl) )  ! UNIT for 3D diagnostic 
    330313            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,   & 
    331314               &          ipk, 1, ipk,  ndepitd, 32, clop, zsto, zout ) 
    … …  
    334317         ! more 2D horizontal arrays 
    335318         DO jl = 1, jpdia2d 
    336             cltra  = ctrc2d(jl)    ! short title for 2D diagnostic 
    337             cltral = ctrc2l(jl)   ! long title for 2D diagnostic 
    338             cltrau = ctrc2u(jl)   ! UNIT for 2D diagnostic 
     319            cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic 
     320            cltral = TRIM( ctrc2l(jl) )  ! long title for 2D diagnostic 
     321            cltrau = TRIM( ctrc2u(jl) )  ! UNIT for 2D diagnostic 
    339322            CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd,  & 
    340323               &          1, 1, 1,  -99, 32, clop, zsto, zout ) 
    … …  
    362345      ! more 3D horizontal arrays 
    363346      DO jl = 1, jpdia3d 
    364          cltra = ctrc3d(jl)   ! short title for 3D diagnostic 
     347         cltra  = TRIM( ctrc3d(jl) )   ! short title for 3D diagnostic 
    365348         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50) 
    366349      END DO 
    … …  
    368351      ! more 2D horizontal arrays 
    369352      DO jl = 1, jpdia2d 
    370          cltra = ctrc2d(jl)   ! short title for 2D diagnostic 
     353         cltra  = TRIM( ctrc2d(jl) )   ! short title for 2D diagnostic 
    371354         CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51) 
    372355      END DO 
    … …  
    468451         ! biological trends 
    469452         DO jl = 1, jpdiabio 
    470             cltra  = ctrbio(jl)   ! short title for biological diagnostic 
    471             cltral = ctrbil(jl)   ! long title for biological diagnostic 
    472             cltrau = ctrbiu(jl)   ! UNIT for biological diagnostic 
     453            cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic 
     454            cltral = TRIM( ctrbil(jl) )  ! long title for biological diagnostic 
     455            cltrau = TRIM( ctrbiu(jl) )  ! UNIT for biological diagnostic 
    473456            CALL histdef( nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb,  & 
    474457               &         ipk, 1, ipk,  ndepitb, 32, clop, zsto, zout) 
    … …  
    494477 
    495478      DO jl = 1, jpdiabio 
    496          cltra = ctrbio(jl)  ! short title for biological diagnostic 
     479         cltra  = TRIM( ctrbio(jl) )   ! short title for biological diagnostic 
    497480         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50) 
    498481      END DO 
    … …  
    513496# endif  
    514497 
     498   INTEGER FUNCTION trc_dia_alloc() 
     499      !!--------------------------------------------------------------------- 
     500      !!                     ***  ROUTINE trc_dia_alloc  *** 
     501      !!--------------------------------------------------------------------- 
     502 
     503      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 
     507   END FUNCTION trc_dia_alloc 
    515508#else 
    516509   !!---------------------------------------------------------------------- 

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

    r2593 r2643  
    4242   !!---------------------------------------------------------------------- 
    4343CONTAINS 
    44  
    45    FUNCTION trc_dta_alloc() 
    46       !!---------------------------------------------------------------------- 
    47       !!                   ***  ROUTINE trc_dta_alloc  *** 
    48       !!---------------------------------------------------------------------- 
    49       INTEGER :: trc_dta_alloc 
    50       !!---------------------------------------------------------------------- 
    51  
    52       ALLOCATE(trdta(jpi,jpj,jpk,jptra),                   & 
    53                tracdta(jpi,jpj,jpk,jptra,2),               & 
    54                nlectr(jptra), ntrc1(jptra), ntrc2,(jptra), &  
    55                ! 
    56                Stat = trc_dta_alloc) 
    57  
    58       IF(trc_dta_alloc /= 0)THEN 
    59          CALL ctl_warn('trc_dta_alloc : failed to allocate arrays.') 
    60       END IF 
    61  
    62    END FUNCTION trc_dta_alloc 
    63  
    6444 
    6545   SUBROUTINE trc_dta( kt ) 
    … …  
    219199   END SUBROUTINE trc_dta 
    220200 
     201   INTEGER FUNCTION trc_dta_alloc() 
     202      !!---------------------------------------------------------------------- 
     203      !!                   ***  ROUTINE trc_dta_alloc  *** 
     204      !!---------------------------------------------------------------------- 
     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 
     214   END FUNCTION trc_dta_alloc 
     215 
    221216#else 
    222217   !!---------------------------------------------------------------------- 

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

    r2630 r2643  
    2828   USE daymod 
    2929   USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    30    USE in_out_manager  ! I/O manager 
    3130   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    32    USE lib_mpp         ! distributed memory computing library 
    33    USE lib_fortran     !  
    3431    
    3532   IMPLICIT NONE 
    … …  
    6764      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    6865 
     66 
    6967      CALL top_alloc()              ! allocate TOP arrays 
    7068 
    … …  
    201199      USE trdmld_trc    , ONLY:   trd_mld_trc_alloc 
    202200#endif 
    203 #if defined key_cfc 
    204      USE trcsms_cfc     , ONLY:   trc_sms_cfc_alloc 
    205 #endif 
    206 #if defined key_c14b 
    207      USE trcsms_c14b    , ONLY:   trc_sms_c14b_alloc 
    208 #endif 
    209 #if defined key_lobster 
    210       USE sms_lobster   , ONLY:   sms_lobster_alloc      ! LOBSTER-related alloc routines... 
    211 #endif 
    212201      ! 
    213202      INTEGER :: ierr 
    … …  
    231220      ierr = ierr + trd_mld_trc_alloc() 
    232221#endif 
    233 #if defined key_cfc 
    234       ierr = ierr + trc_sms_cfc_alloc() 
    235 #endif 
    236 #if defined key_c14b 
    237       ierr = ierr + trc_sms_c14b_alloc() 
    238 #endif 
    239       ! 
    240 #if defined key_lobster 
    241       ierr = ierr + sms_lobster_alloc()      ! Start of LOBSTER-related alloc routines 
    242 #endif 
    243222      ! 
    244223      IF( lk_mpp    )   CALL mpp_sum( ierr ) 

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

    r2636 r2643  
    2626   USE trcnam_c14b       ! C14 SMS namelist 
    2727   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    28    USE in_out_manager    ! I/O manager 
    29    USE lib_mpp           ! MPP library 
    3028   USE trdmod_trc_oce 
    3129 
    … …  
    104102 
    105103      DO jn = 1, jptra 
    106          ctrcnm(jn) = sn_tracer(jn)%clsname 
    107          ctrcnl(jn) = sn_tracer(jn)%cllname 
    108          ctrcun(jn) = sn_tracer(jn)%clunit 
    109          lutini(jn) = sn_tracer(jn)%llinit 
    110          lutsav(jn) = sn_tracer(jn)%llsave 
     104         ctrcnm(jn) = TRIM( sn_tracer(jn)%clsname ) 
     105         ctrcnl(jn) = TRIM( sn_tracer(jn)%cllname ) 
     106         ctrcun(jn) = TRIM( sn_tracer(jn)%clunit  ) 
     107         lutini(jn) =       sn_tracer(jn)%llinit  
     108         lutsav(jn) =       sn_tracer(jn)%llsave 
    111109      END DO 
    112110 
    … …  
    122120         DO jn = 1, jptra 
    123121            WRITE(numout,*) '   tracer nb             : ', jn  
    124             WRITE(numout,*) '   short name            : ', TRIM(ctrcnm(jn)) 
    125             WRITE(numout,*) '   long name             : ', TRIM(ctrcnl(jn)) 
    126             WRITE(numout,*) '   unit                  : ', TRIM(ctrcun(jn)) 
     122            WRITE(numout,*) '   short name            : ', ctrcnm(jn) 
     123            WRITE(numout,*) '   long name             : ', ctrcnl(jn) 
     124            WRITE(numout,*) '   unit                  : ', ctrcun(jn) 
    127125            WRITE(numout,*) '   initial value in FILE : ', lutini(jn)  
    128126            WRITE(numout,*) ' ' 

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

    r2528 r2643  
    2626   USE trc 
    2727   USE trcnam_trp 
    28    USE lib_mpp 
    29    USE lib_fortran 
    3028   USE iom 
    3129   USE trcrst_cfc      ! CFC       

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

    r2528 r2643  
    6464         ELSE                  ;   CALL trc_dia( kt ) 
    6565         ENDIF 
    66                                    CALL trc_sms( kt )           ! tracers: sink and source 
     66      !                             CALL trc_sms( kt )           ! tracers: sink and source 
    6767                                   CALL trc_trp( kt )           ! transport of passive tracers 
    6868         IF( kt == nit000 )     CALL iom_close( numrtr )     ! close input  passive tracers restart file 
Note: See TracChangeset for help on using the changeset viewer.