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

Changeset 2623


Ignore:
Timestamp:
2011-02-27T13:45:53+01:00 (13 years ago)
Author:
gm
Message:

dynamic mem: #785 ; TRA: move dyn allocation from nemogcm to module when possible (continuation)

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2619 r2623  
    5858   REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    5959   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttra  !: vertical profile of tracer time step 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dtra  !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 
    6061 
    6162   !                                         !!* Namelist namcla : cross land advection 
    … …  
    261262      ierr(:) = 0 
    262263 
    263       ALLOCATE( rdttra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
     264      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
    264265 
    265266      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r2590 r2623  
    3232   PUBLIC   tra_adv        ! routine called by step module 
    3333   PUBLIC   tra_adv_init   ! routine called by opa module 
    34    PUBLIC   tra_adv_alloc  ! routine called by nemogcm module 
    3534 
    3635   !                                        !!* Namelist namtra_adv * 
    … …  
    4443   INTEGER ::   nadv   ! choice of the type of advection scheme 
    4544 
    46    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::   r2dt   ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 
    47  
    4845   !! * Substitutions 
    4946#  include "domzgr_substitute.h90" 
    … …  
    5552   !!---------------------------------------------------------------------- 
    5653CONTAINS 
    57  
    58    FUNCTION tra_adv_alloc() 
    59       !!---------------------------------------------------------------------- 
    60       !!                ***  ROUTINE tra_adv_alloc  *** 
    61       !!---------------------------------------------------------------------- 
    62       IMPLICIT none 
    63       INTEGER tra_adv_alloc 
    64       !!---------------------------------------------------------------------- 
    65  
    66       ALLOCATE( r2dt(jpk), Stat=tra_adv_alloc) 
    67  
    68       IF(tra_adv_alloc /= 0)THEN 
    69          CALL ctl_warn('tra_adv_alloc: failed to allocate array.') 
    70       END IF 
    71  
    72    END FUNCTION tra_adv_alloc 
    7354 
    7455   SUBROUTINE tra_adv( kt ) 
    … …  
    8061      !! ** Method  : - Update (ua,va) with the advection term following nadv 
    8162      !!---------------------------------------------------------------------- 
    82       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    83       USE wrk_nemo, ONLY: zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3 
     63      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     64      USE wrk_nemo, ONLY:   zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3   ! 3D workspace 
     65      ! 
    8466      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    8567      ! 
    … …  
    8769      !!---------------------------------------------------------------------- 
    8870      ! 
    89       IF(.not. wrk_use(3,1,2,3))THEN 
    90          CALL ctl_stop('tra_adv: ERROR: requested workspace arrays unavailable') 
    91          RETURN 
     71      IF(.not. wrk_use(3, 1,2,3) ) THEN 
     72         CALL ctl_stop('tra_adv: requested workspace arrays unavailable')   ;   RETURN 
    9273      END IF 
    9374      !                                          ! set time step 
    9475      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    95          r2dt(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
     76         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
    9677      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    97          r2dt(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
     78         r2dtra(:) = 2._wp * rdttra(:)                   ! = 2 rdttra (leapfrog) 
    9879      ENDIF 
    9980      ! 
    … …  
    11899 
    119100      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    120       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRA',       zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
    121       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
    122       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL  
    123       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
    124       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
    125       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
     101      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  2nd order centered 
     102      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  TVD  
     103      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )   !  MUSCL  
     104      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  MUSCL2  
     105      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  UBS  
     106      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )   !  QUICKEST  
    126107      ! 
    127108      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    128          CALL tra_adv_cen2  ( kt, 'TRA',       zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     109         CALL tra_adv_cen2  ( kt, 'TRA',         zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    129110         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask,               & 
    130111            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    131          CALL tra_adv_tvd   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     112         CALL tra_adv_tvd   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    132113         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask,               & 
    133114            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    134          CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts )           
     115         CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb,      tsa, jpts )           
    135116         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask,               & 
    136117            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    137          CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     118         CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    138119         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask,               & 
    139120            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    140          CALL tra_adv_ubs   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     121         CALL tra_adv_ubs   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    141122         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask,               & 
    142123            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    143          CALL tra_adv_qck   ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
     124         CALL tra_adv_qck   ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )           
    144125         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask,               & 
    145126            &          tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    … …  
    150131         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    151132      ! 
    152       IF(.not. wrk_release(3,1,2,3))THEN 
    153          CALL ctl_stop('tra_adv: ERROR: failed to release workspace arrays') 
    154          RETURN 
    155       END IF 
     133      IF(.not. wrk_release(3,1,2,3) )   CALL ctl_stop('tra_adv: failed to release workspace arrays') 
    156134      ! 
    157135   END SUBROUTINE tra_adv 
    … …  
    172150      !!---------------------------------------------------------------------- 
    173151 
    174       REWIND ( numnam )               ! Read Namelist namtra_adv : tracer advection scheme 
    175       READ   ( numnam, namtra_adv ) 
     152      REWIND( numnam )                ! Read Namelist namtra_adv : tracer advection scheme 
     153      READ  ( numnam, namtra_adv ) 
    176154 
    177155      IF(lwp) THEN                    ! Namelist print 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2590 r2623  
    3737   PUBLIC   tra_adv_cen2       ! routine called by step.F90 
    3838   PUBLIC   ups_orca_set       ! routine used by traadv_cen2_jki.F90 
    39    PUBLIC   tra_adv_cen2_alloc ! routine called by nemogcm.F90 
    4039 
    4140   LOGICAL  :: l_trd       ! flag to compute trends 
    … …  
    5251   !!---------------------------------------------------------------------- 
    5352CONTAINS 
    54  
    55    FUNCTION tra_adv_cen2_alloc() 
    56       !!---------------------------------------------------------------------- 
    57       !!               ***  ROUTINE tra_adv_cen2_alloc  *** 
    58       !!---------------------------------------------------------------------- 
    59       IMPLICIT none 
    60       INTEGER :: tra_adv_cen2_alloc 
    61       !!---------------------------------------------------------------------- 
    62  
    63       ALLOCATE(upsmsk(jpi,jpj), Stat=tra_adv_cen2_alloc) 
    64  
    65       IF(tra_adv_cen2_alloc > 0)THEN 
    66          CALL ctl_warn('tra_adv_cen2_alloc: failed to allocate array.') 
    67       END IF 
    68  
    69    END FUNCTION tra_adv_cen2_alloc 
    7053 
    7154   SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn,        & 
    … …  
    140123      !! 
    141124      INTEGER  ::   ji, jj, jk, jn                   ! dummy loop indices 
    142       REAL(wp) ::   zbtr, ztra                       ! temporary scalars 
    143       REAL(wp) ::   zfp_ui, zfp_vj, zfp_w            !    -         - 
    144       REAL(wp) ::   zfm_ui, zfm_vj, zfm_w            !    -         - 
    145       REAL(wp) ::   zcofi , zcofj , zcofk            !    -         - 
    146       REAL(wp) ::   zupsut, zcenut                   !    -         - 
    147       REAL(wp) ::   zupsvt, zcenvt                   !    -         - 
    148       REAL(wp) ::   zupst , zcent                    !    -         - 
    149       REAL(wp) ::   zice                             !    -         - 
    150       !!---------------------------------------------------------------------- 
    151  
    152       IF( (.not. wrk_use(2, 1)) .OR. (.not. wrk_use(3, 1,2)))THEN 
    153          CALL ctl_stop('tra_adv_cen2: ERROR: requested workspace arrays unavailable') 
    154          RETURN 
     125      INTEGER  ::   ierr                             ! local integer 
     126      REAL(wp) ::   zbtr, ztra                       ! local scalars 
     127      REAL(wp) ::   zfp_ui, zfp_vj, zfp_w            !   -      - 
     128      REAL(wp) ::   zfm_ui, zfm_vj, zfm_w            !   -      - 
     129      REAL(wp) ::   zcofi , zcofj , zcofk            !   -      - 
     130      REAL(wp) ::   zupsut, zcenut                   !   -      - 
     131      REAL(wp) ::   zupsvt, zcenvt                   !   -      - 
     132      REAL(wp) ::   zupst , zcent                    !   -      - 
     133      REAL(wp) ::   zice                             !   -      - 
     134      !!---------------------------------------------------------------------- 
     135 
     136      IF( .not. wrk_use(2, 1) .OR. .not. wrk_use(3, 1,2) ) THEN 
     137         CALL ctl_stop('tra_adv_cen2: ERROR: requested workspace arrays unavailable')   ;   RETURN 
    155138      END IF 
    156139 
    … …  
    161144         IF(lwp) WRITE(numout,*) 
    162145         ! 
    163          upsmsk(:,:) = 0.e0                              ! not upstream by default 
     146         ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
     147         IF( ierr /= 0 )   CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') 
     148         ! 
     149         upsmsk(:,:) = 0._wp                             ! not upstream by default 
    164150         !  
    165151         IF( cp_cfg == "orca" )   CALL ups_orca_set      ! set mixed Upstream/centered scheme near some straits 
    … …  
    173159         ! 
    174160         l_trd = .FALSE. 
    175          IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     161         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) )   l_trd = .TRUE. 
    176162      ENDIF 
    177163      ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r2590 r2623  
    1717   !!   'key_trabbl'   or                             bottom boundary layer 
    1818   !!---------------------------------------------------------------------- 
     19   !!   tra_bbl_alloc : allocate trabbl arrays 
    1920   !!   tra_bbl       : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 
    2021   !!   tra_bbl_dif   : generic routine to compute bbl diffusive trend 
    … …  
    4243   PUBLIC   tra_bbl_adv   !  -          -          -              - 
    4344   PUBLIC   bbl           !  routine called by trcbbl.F90 and dtadyn.F90 
    44    PUBLIC   tra_bbl_alloc !  routine called by nemogcm.F90 
    4545 
    4646   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbl = .TRUE.    !: bottom boundary layer flag 
    … …  
    5454   REAL(wp), PUBLIC ::   rn_gambbl  = 10.0_wp   !: lateral coeff. for bottom boundary layer scheme [s] 
    5555 
     56   LOGICAL , PUBLIC ::   l_bbl                  !: flag to compute bbl diffu. flux coef and transport 
     57    
    5658   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   utr_bbl  , vtr_bbl   ! u- (v-) transport in the bottom boundary layer 
    57    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coefficients at u and v-points 
     59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC ::   ahu_bbl  , ahv_bbl   ! masked diffusive bbl coeff. at u & v-pts 
    5860 
    5961   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbku_d   , mbkv_d      ! vertical index of the "lower" bottom ocean U/V-level 
    … …  
    6163   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ahu_bbl_0, ahv_bbl_0   ! diffusive bbl flux coefficients at u and v-points 
    6264   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3u_bbl_0, e3v_bbl_0   ! thichness of the bbl (e3) at u and v-points 
    63    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t_r   ! thichness of the bbl (e3) at u and v-points 
    64    LOGICAL, PUBLIC              ::   l_bbl                    !: flag to compute bbl diffu. flux coef and transport 
     65   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t               ! inverse of the cell surface at t-point      [1/m2] 
    6566 
    6667   !! * Substitutions 
    … …  
    7475CONTAINS 
    7576 
    76    FUNCTION tra_bbl_alloc() 
    77       IMPLICIT none 
    78       INTEGER :: tra_bbl_alloc 
    79  
    80       ALLOCATE(utr_bbl(jpi,jpj),   vtr_bbl(jpi,jpj),   & 
    81                ahu_bbl(jpi,jpj),   ahv_bbl(jpi,jpj),   & 
    82                mbku_d(jpi,jpj),    mbkv_d(jpi,jpj),    & 
    83                mgrhu(jpi,jpj),     mgrhv(jpi,jpj),     & 
    84                ahu_bbl_0(jpi,jpj), ahv_bbl_0(jpi,jpj), & 
    85                e3u_bbl_0(jpi,jpj), e3v_bbl_0(jpi,jpj), & 
    86                e1e2t_r(jpi,jpj),                       & 
    87                Stat=tra_bbl_alloc) 
    88  
    89       IF(tra_bbl_alloc > 0)THEN 
    90          CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.') 
    91       END IF 
    92  
     77   INTEGER FUNCTION tra_bbl_alloc() 
     78      !!---------------------------------------------------------------------- 
     79      !!                ***  FUNCTION tra_bbl_alloc  *** 
     80      !!---------------------------------------------------------------------- 
     81      ALLOCATE( utr_bbl  (jpi,jpj) , ahu_bbl  (jpi,jpj) , mbku_d  (jpi,jpj) , mgrhu(jpi,jpj) ,     & 
     82         &      vtr_bbl  (jpi,jpj) , ahv_bbl  (jpi,jpj) , mbkv_d  (jpi,jpj) , mgrhv(jpi,jpj) ,     & 
     83         &      ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) ,                                          & 
     84         &      e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj)                  , STAT=tra_bbl_alloc) 
     85         ! 
     86      IF( lk_mpp            )   CALL mpp_sum ( tra_bbl_alloc ) 
     87      IF( tra_bbl_alloc > 0 )   CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.') 
    9388   END FUNCTION tra_bbl_alloc 
     89 
    9490 
    9591   SUBROUTINE tra_bbl( kt ) 
    … …  
    173169      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    174170      !!----------------------------------------------------------------------   
    175       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    176       USE wrk_nemo, ONLY: zptb => wrk_2d_1 
    177       !! 
     171      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     172      USE wrk_nemo, ONLY:   zptb => wrk_2d_1 
     173      ! 
    178174      INTEGER                              , INTENT(in   ) ::   kjpt    ! number of tracers 
    179175      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb   ! before and now tracer fields 
    180176      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta   ! tracer trend  
    181       !! 
     177      ! 
    182178      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    183179      INTEGER  ::   ik           ! local integers 
    … …  
    185181      !!---------------------------------------------------------------------- 
    186182      ! 
    187       IF(.not. wrk_use(2,1))THEN 
    188          CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable') 
    189          RETURN 
    190       END IF 
     183      IF(.not. wrk_use(2,1) ) THEN 
     184         CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable')   ;   RETURN 
     185      ENDIF 
    191186      ! 
    192187      DO jn = 1, kjpt                                     ! tracer loop 
    … …  
    212207#  endif 
    213208               ik = mbkt(ji,jj)                            ! bottom T-level index 
    214                zbtr = e1e2t_r(ji,jj)  / fse3t(ji,jj,ik) 
     209               zbtr = r1_e1e2t(ji,jj)  / fse3t(ji,jj,ik) 
    215210               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                         & 
    216211                  &               + (   ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )   & 
    … …  
    223218      END DO                                                ! end tracer 
    224219      !                                                     ! =========== 
    225       IF(.not. wrk_release(2,1))THEN 
    226          CALL ctl_stop('tra_bbl_dif: ERROR: failed to release workspace array') 
    227       END IF 
     220      IF(.not. wrk_release(2,1) )   CALL ctl_stop('tra_bbl_dif: failed to release workspace array') 
    228221      ! 
    229222   END SUBROUTINE tra_bbl_dif 
    … …  
    273266                  ! 
    274267                  !                                               ! up  -slope T-point (shelf bottom point) 
    275                   zbtr = e1e2t_r(iis,jj) / fse3t(iis,jj,ikus) 
     268                  zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 
    276269                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
    277270                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
    278271                  !                    
    279272                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    280                      zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,jk) 
     273                     zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 
    281274                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
    282275                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
    283276                  END DO 
    284277                  !  
    285                   zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,ikud) 
     278                  zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 
    286279                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
    287280                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
    … …  
    295288                  !  
    296289                  ! up  -slope T-point (shelf bottom point) 
    297                   zbtr = e1e2t_r(ji,ijs) / fse3t(ji,ijs,ikvs) 
     290                  zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 
    298291                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
    299292                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
    300293                  !                    
    301294                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    302                      zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,jk) 
     295                     zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 
    303296                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
    304297                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
    305298                  END DO 
    306299                  !                                               ! down-slope T-point (deep bottom point) 
    307                   zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,ikvd) 
     300                  zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 
    308301                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
    309302                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
    … …  
    345338      !!              Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 
    346339      !!----------------------------------------------------------------------   
    347       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    348       USE wrk_nemo, ONLY: zub => wrk_2d_1, zvb => wrk_2d_2, ztb => wrk_2d_3, & 
    349                           zsb => wrk_2d_4, zdep => wrk_2d_5 
     340      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     341      USE wrk_nemo, ONLY:   zub => wrk_2d_1 , ztb => wrk_2d_2                      ! 2D workspace 
     342      USE wrk_nemo, ONLY:   zvb => wrk_2d_3 , zsb => wrk_2d_4 , zdep => wrk_2d_5 
     343      ! 
    350344      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    351345      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    … …  
    391385      !!---------------------------------------------------------------------- 
    392386 
    393       IF(.not. wrk_use(2, 1,2,3,4,5))THEN 
    394          CALL ctl_stop('bbl: ERROR: requested workspace arrays unavailable') 
    395          RETURN 
    396       END IF 
     387      IF(.not. wrk_use(2, 1,2,3,4,5) ) THEN 
     388         CALL ctl_stop('bbl: requested workspace arrays unavailable')   ;   RETURN 
     389      ENDIF 
    397390      
    398391      IF( kt == nit000 )  THEN 
    … …  
    532525      ENDIF 
    533526      ! 
    534       IF(.not. wrk_release(2, 1,2,3,4,5))THEN 
    535          CALL ctl_stop('bbl: ERROR: failed to release workspace arrays') 
    536       END IF 
     527      IF(.not. wrk_release(2, 1,2,3,4,5) )   CALL ctl_stop('bbl: failed to release workspace arrays') 
    537528      ! 
    538529   END SUBROUTINE bbl 
    … …  
    546537      !! 
    547538      !! ** Method  :   Read the nambbl namelist and check the parameters 
    548       !!              called by tra_bbl at the first timestep (nit000) 
    549       !!---------------------------------------------------------------------- 
    550       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    551       USE wrk_nemo, ONLY: zmbk => wrk_2d_1 
     539      !!              called by nemo_init at the first timestep (nit000) 
     540      !!---------------------------------------------------------------------- 
     541      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     542      USE wrk_nemo, ONLY:   zmbk => wrk_2d_1       ! 2D workspace 
    552543      INTEGER ::   ji, jj               ! dummy loop indices 
    553544      INTEGER ::   ii0, ii1, ij0, ij1   ! temporary integer 
    … …  
    556547      !!---------------------------------------------------------------------- 
    557548 
    558       IF(.not. wrk_use(2,1))THEN 
    559          CALL ctl_stop('tra_bbl_init: ERROR: requested workspace array unavailable') 
    560          RETURN 
    561       END IF 
     549      IF(.not. wrk_use(2,1) ) THEN 
     550         CALL ctl_stop('tra_bbl_init: requested workspace array unavailable')   ;   RETURN 
     551      ENDIF 
    562552 
    563553      REWIND ( numnam )              !* Read Namelist nambbl : bottom boundary layer scheme 
    … …  
    576566         WRITE(numout,*) '          advective bbl coefficient           rn_gambbl  = ', rn_gambbl, ' s' 
    577567      ENDIF 
    578        
     568 
     569      !                              ! allocate trabbl arrays 
     570      IF( tra_bbl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 
     571      
    579572      IF( nn_bbl_adv == 1 )    WRITE(numout,*) '       * Advective BBL using upper velocity' 
    580573      IF( nn_bbl_adv == 2 )    WRITE(numout,*) '       * Advective BBL using velocity = F( delta rho)' 
    … …  
    584577 
    585578      !                             !* inverse of surface of T-cells 
    586       e1e2t_r(:,:) = 1.0 / ( e1t(:,:) * e2t(:,:) ) 
     579      r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) ) 
    587580       
    588581      !                             !* vertical index of  "deep" bottom u- and v-points 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r2590 r2623  
    1919   !!   'key_tradmp'                                       internal damping 
    2020   !!---------------------------------------------------------------------- 
     21   !!   tra_dmp_alloc : allocate tradmp arrays 
    2122   !!   tra_dmp       : update the tracer trend with the internal damping 
    2223   !!   tra_dmp_init  : initialization, namlist read, parameters control 
    … …  
    4546   PUBLIC   dtacof       ! routine called by in both tradmp.F90 and trcdmp.F90 
    4647   PUBLIC   dtacof_zoom  ! routine called by in both tradmp.F90 and trcdmp.F90 
    47    PUBLIC   tra_dmp_alloc ! routine called by nemogcm.F90 
    4848 
    4949#if ! defined key_agrif 
    … …  
    7474CONTAINS 
    7575 
    76    FUNCTION tra_dmp_alloc() 
    77       IMPLICIT none 
    78       INTEGER :: tra_dmp_alloc 
    79  
    80       ALLOCATE(strdmp(jpi,jpj,jpk), ttrdmp(jpi,jpj,jpk), & 
    81                resto(jpi,jpj,jpk), Stat=tra_dmp_alloc) 
    82  
    83       IF(tra_dmp_alloc /= 0)THEN 
    84          CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed.') 
    85       END IF 
    86  
     76   INTEGER FUNCTION tra_dmp_alloc() 
     77      !!---------------------------------------------------------------------- 
     78      !!                ***  FUNCTION tra_bbl_alloc  *** 
     79      !!---------------------------------------------------------------------- 
     80      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT=tra_dmp_alloc ) 
     81      ! 
     82      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
     83      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed.') 
    8784   END FUNCTION tra_dmp_alloc 
     85 
    8886 
    8987   SUBROUTINE tra_dmp( kt ) 
    … …  
    207205      ENDIF 
    208206 
     207      !                              ! allocate tradmp arrays 
     208      IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init : unable to allocate arrays' ) 
     209 
    209210      SELECT CASE ( nn_hdmp ) 
    210211      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
    … …  
    326327      USE iom 
    327328      USE ioipsl 
    328       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    329       USE wrk_nemo, ONLY: zhfac => wrk_1d_1, zmrs => wrk_2d_1 
    330       USE wrk_nemo, ONLY: zdct => wrk_3d_1 
     329      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     330      USE wrk_nemo, ONLY:   zhfac => wrk_1d_1, zmrs => wrk_2d_1 , zdct  => wrk_3d_1   ! 1D, 2D, 3D workspace 
    331331      !! 
    332332      INTEGER                         , INTENT(in   )  ::  kn_hdmp    ! damping option 
    … …  
    347347      !!---------------------------------------------------------------------- 
    348348 
    349       IF( (.not. wrk_use(1,1)) .OR. (.not. wrk_use(2,1)) .OR. & 
    350           (.not. wrk_use(3,1)))THEN 
    351          CALL ctl_stop('dtacof: ERROR: requested workspace arrays unavailable') 
    352          RETURN 
    353       END IF 
     349      IF( .not. wrk_use(1, 1) .OR. .not. wrk_use(2, 1)  .OR.   & 
     350          .not. wrk_use(3, 1)   )THEN 
     351         CALL ctl_stop('dtacof: requested workspace arrays unavailable')   ;   RETURN 
     352      ENDIF 
    354353      !                                   ! ==================== 
    355354      !                                   !  ORCA configuration : global domain 
    … …  
    544543      ENDIF 
    545544      ! 
    546       IF( (.not. wrk_release(1,1)) .OR. (.not. wrk_release(2,1)) .OR. & 
    547           (.not. wrk_release(3,1)) )THEN 
    548          CALL ctl_stop('dtacof: ERROR: failed to release workspace arrays') 
    549       END IF 
     545      IF( .not. wrk_release(1, 1) .OR. .not. wrk_release(2, 1) .OR. & 
     546          .not. wrk_release(3, 1) )   CALL ctl_stop('dtacof: failed to release workspace arrays') 
    550547      ! 
    551548   END SUBROUTINE dtacof 
    … …  
    573570      !!---------------------------------------------------------------------- 
    574571      USE ioipsl      ! IOipsl librairy 
    575       USE wrk_nemo, ONLY: wrk_use, wrk_release, llwrk_use, llwrk_release 
    576       USE wrk_nemo, ONLY: zxc => wrk_1d_1, zyc => wrk_1d_2, & 
    577                           zzc => wrk_1d_3, zdis => wrk_1d_4 
    578       USE wrk_nemo, ONLY: llcotu => llwrk_2d_1, llcotv => llwrk_2d_2, & 
    579                           llcotf => llwrk_2d_3 
    580       USE wrk_nemo, ONLY: zxt => wrk_2d_1, zyt => wrk_2d_2, & 
    581                           zzt => wrk_2d_3, zmask => wrk_2d_4 
     572      USE wrk_nemo, ONLY:   wrk_use, wrk_release, llwrk_use, llwrk_release 
     573      USE wrk_nemo, ONLY:   zxc => wrk_1d_1, zyc  => wrk_1d_2, zzc => wrk_1d_3, zdis => wrk_1d_4 
     574      USE wrk_nemo, ONLY:   llcotu => llwrk_2d_1, llcotv => llwrk_2d_2 , llcotf => llwrk_2d_3 
     575      USE wrk_nemo, ONLY:   zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4 
    582576      !! 
    583577      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline 
    … …  
    592586      !!---------------------------------------------------------------------- 
    593587 
    594       IF( (.not. llwrk_use(2,1,2,3)) .OR. (.not. wrk_use(2, 1,2,3,4)) .OR. & 
    595           (.not. wrk_use(1, 1,2,3,4)) )THEN 
    596          CALL ctl_stop('cofdis: ERROR: requested workspace arrays unavailable') 
    597          RETURN 
     588      IF( .not. llwrk_use(2, 1,2,3)  .OR. .not. wrk_use(2, 1,2,3,4)  .OR.   & 
     589          .not.   wrk_use(1, 1,2,3,4)  )THEN 
     590         CALL ctl_stop('cofdis: ERROR: requested workspace arrays unavailable')   ;   RETURN 
    598591      END IF 
    599592 
    … …  
    748741      CALL restclo( icot ) 
    749742      ! 
    750       IF( (.not. llwrk_release(2, 1,2,3)) .OR. & 
    751           (.not. wrk_release(2, 1,2,3,4)) .OR. &  
    752           (.not. wrk_release(1, 1,2,3,4)) )THEN 
    753          CALL ctl_stop('cofdis: ERROR: failed to release workspace arrays') 
    754       END IF 
     743      IF( .not. llwrk_release(2, 1,2,3)   .OR. & 
     744          .not.   wrk_release(2, 1,2,3,4) .OR. &  
     745          .not.   wrk_release(1, 1,2,3,4)  )   CALL ctl_stop('cofdis: failed to release workspace arrays') 
    755746      ! 
    756747   END SUBROUTINE cofdis 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90

    r2590 r2623  
    3535   PUBLIC   tra_ldf         ! called by step.F90  
    3636   PUBLIC   tra_ldf_init    ! called by opa.F90  
    37    PUBLIC   tra_ldf_alloc   ! called by nemogcm.F90 
    3837   ! 
    3938   INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 
    40 #if defined key_traldf_ano 
    41    REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   ! lateral diffusion trends of T & S for a constant profile 
    42 #endif 
     39 
     40   REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   t0_ldf, s0_ldf   !: lateral diffusion trends of T & S for a cst profile 
     41   !                                                               !  (key_traldf_ano only) 
    4342 
    4443   !! * Substitutions 
    … …  
    5150   !!---------------------------------------------------------------------- 
    5251CONTAINS 
    53  
    54    FUNCTION tra_ldf_alloc() 
    55       IMPLICIT none 
    56       INTEGER :: tra_ldf_alloc 
    57  
    58       tra_ldf_alloc = 0 
    59  
    60 #if defined key_traldf_ano 
    61       ALLOCATE(t0_ldf(jpi,jpj,jpk), s0_ldf(jpi,jpj,jpk), Stat=tra_ldf_alloc) 
    62 #endif 
    63  
    64       IF(tra_ldf_alloc /= 0)THEN 
    65          CALL ctl_warn('tra_ldf_alloc: failed to allocate arrays t0_ldf and s0_ldf.') 
    66       END IF 
    67  
    68    END FUNCTION tra_ldf_alloc 
    6952 
    7053   SUBROUTINE tra_ldf( kt ) 
    … …  
    147130      !!---------------------------------------------------------------------- 
    148131      INTEGER ::   ioptio, ierr         ! temporary integers  
    149 !       
    150132      !!---------------------------------------------------------------------- 
    151133 
    … …  
    256238      !!---------------------------------------------------------------------- 
    257239      USE wrk_nemo, ONLY: wrk_use, wrk_release 
    258       USE wrk_nemo, ONLY: zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3  
    259       USE wrk_nemo, ONLY: zs_ref => wrk_3d_4, zsb => wrk_3d_5 ! 3D workspaces 
     240      USE wrk_nemo, ONLY: zt_ref => wrk_3d_1, ztb => wrk_3d_2, zavt => wrk_3d_3   ! 3D workspaces 
     241      USE wrk_nemo, ONLY: zs_ref => wrk_3d_4, zsb => wrk_3d_5                     ! 3D workspaces 
    260242      !!  
    261243      USE zdf_oce         ! vertical mixing 
    … …  
    264246      !! 
    265247      INTEGER  ::   jk              ! Dummy loop indice 
     248      INTEGER  ::   ierr            ! local integer 
    266249      LOGICAL  ::   llsave          ! 
    267       REAL(wp) ::   zt0, zs0, z12   ! temporary scalar 
    268       !!---------------------------------------------------------------------- 
    269  
    270       IF(.NOT. wrk_use(3, 1,2,3,4,5))THEN 
    271          CALL ctl_stop('ldf_ano : requested workspace arrays unavailable.') 
    272          RETURN 
    273       END IF 
     250      REAL(wp) ::   zt0, zs0, z12   ! local scalar 
     251      !!---------------------------------------------------------------------- 
     252 
     253      IF(.NOT. wrk_use(3, 1,2,3,4,5) ) THEN 
     254         CALL ctl_stop('ldf_ano : requested workspace arrays unavailable')   ;   RETURN 
     255      ENDIF 
    274256 
    275257      IF(lwp) THEN 
    … …  
    278260         WRITE(numout,*) '~~~~~~~~~~~' 
    279261      ENDIF 
     262 
     263      !                              ! allocate trabbl arrays 
     264      ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr ) 
     265      IF( lk_mpp    )   CALL ctl_warn( ierr ) 
     266      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_ano : unable to allocate arrays' ) 
    280267 
    281268      ! defined the T & S reference profiles 
    … …  
    333320      avt(:,:,:)        = zavt(:,:,:) 
    334321      ! 
    335       IF(.NOT. wrk_release(3, 1,2,3,4,5))THEN 
    336          CALL ctl_stop('ldf_ano : failed to release workspace arrays.') 
    337       END IF 
     322      IF(.NOT. wrk_release(3, 1,2,3,4,5) )   CALL ctl_stop('ldf_ano : failed to release workspace arrays') 
    338323      ! 
    339324   END SUBROUTINE ldf_ano 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90

    r2613 r2623  
    1616   USE oce             ! ocean dynamics and active tracers 
    1717   USE dom_oce         ! ocean space and time domain 
     18   USE phycst          ! physical constants 
    1819   USE trc_oce         ! share passive tracers/Ocean variables 
    1920   USE zdf_oce         ! ocean vertical physics 
    … …  
    2324   USE in_out_manager  ! I/O manager 
    2425   USE iom             ! I/O library 
    25 #if defined key_diaar5 
    26    USE phycst          ! physical constants 
    2726   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    28 #endif 
    2927 
    3028   IMPLICIT NONE 
    3129   PRIVATE 
    3230 
    33    PUBLIC tra_ldf_iso_grif       ! routine called by traldf.F90 
    34    PUBLIC tra_ldf_iso_grif_alloc ! routine called by nemogcm.F90 
    35  
    36    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE       ::   psix_eiv 
    37    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE       ::   psiy_eiv 
    38    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE       ::   ah_wslp2 
    39    REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt  ! 2D+1 workspace 
     31   PUBLIC   tra_ldf_iso_grif   ! routine called by traldf.F90 
     32 
     33   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   psix_eiv, psiy_eiv   !: eiv stream function (diag only) 
     34   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   ah_wslp2             !: aeiv*w-slope^2 
     35   REAL(wp),         DIMENSION(:,:,:), ALLOCATABLE, SAVE ::   zdkt                 !  atypic workspace 
    4036 
    4137   !! * Substitutions 
    … …  
    5046   !!---------------------------------------------------------------------- 
    5147CONTAINS 
    52  
    53   FUNCTION tra_ldf_iso_grif_alloc() 
    54       !!---------------------------------------------------------------------- 
    55       !!                ***  ROUTINE tra_ldf_iso_grif_alloc  *** 
    56       !!---------------------------------------------------------------------- 
    57       INTEGER :: tra_ldf_iso_grif_alloc 
    58       !!---------------------------------------------------------------------- 
    59       ! 
    60       ALLOCATE(zdkt(jpi,jpj,0:1), Stat=tra_ldf_iso_grif_alloc) 
    61       ! 
    62       IF( tra_ldf_iso_grif_alloc /= 0 )   CALL ctl_warn('tra_ldf_iso_grif_alloc : allocation of arrays failed.') 
    63       ! 
    64   END FUNCTION tra_ldf_iso_grif_alloc 
    65  
    6648 
    6749  SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv,              & 
    … …  
    10688      !! ** Action :   Update pta arrays with the before rotated diffusion 
    10789      !!---------------------------------------------------------------------- 
    108       USE oce,   zftu => ua   ! use ua as workspace 
    109       USE oce,   zftv => va   ! use va as workspace 
    110       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    111       USE wrk_nemo, ONLY: zdit => wrk_3d_1, zdjt => wrk_3d_2, ztfw => wrk_3d_3 
    112       !USE wrk_nemo, ONLY: wrk_3d_4 ! For 2D+1 workspace 
    113       USE wrk_nemo, ONLY: z2d => wrk_2d_1 ! Only used if key_diaar5 defined 
     90      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     91      USE oce     , ONLY:   zftu => ua       , zftv => va            ! (ua,va) used as 3D workspace 
     92      USE wrk_nemo, ONLY:   zdit => wrk_3d_1 , zdjt => wrk_3d_2 , ztfw => wrk_3d_3   ! 3D workspace 
     93      USE wrk_nemo, ONLY:   z2d  => wrk_2d_1                                          ! 2D workspace 
    11494      !! 
    11595      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    137117      !!---------------------------------------------------------------------- 
    138118 
    139       ! Check that workspace arrays are free for use 
    140       IF( (.NOT. wrk_use(3, 1,2,3)) .OR. (.NOT. wrk_use(2, 1)))THEN 
    141          CALL ctl_stop('tra_ldf_iso_grif : requested workspace arrays unavailable.') 
    142          RETURN 
    143       END IF 
     119      IF( .NOT. wrk_use(3, 1,2,3) .OR. .NOT. wrk_use(2, 1) ) THEN 
     120         CALL ctl_stop('tra_ldf_iso_grif : requested workspace arrays unavailable.')   ;   RETURN 
     121      ENDIF 
    144122      ! ARP - line below uses 'bounds re-mapping' which is only defined in 
    145123      ! Fortran 2003 and up. We would be OK if code was written to use 
    … …  
    153131         IF(lwp) WRITE(numout,*) '                   WARNING: STILL UNDER TEST, NOT RECOMMENDED. USE AT YOUR OWN PERIL' 
    154132         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    155          ALLOCATE( ah_wslp2(jpi,jpj,jpk) , STAT=ierr ) 
    156          IF( ierr > 0 ) THEN 
    157             CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator ah_wslp2 ' )   ;   RETURN 
    158          ENDIF 
     133         ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt(jpi,jpj,0:1), STAT=ierr ) 
     134         IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
     135         IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 
    159136         IF( ln_traldf_gdia ) THEN 
    160137            ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 
    161             IF( ierr > 0 ) THEN 
    162                CALL ctl_stop( 'tra_ldf_iso_grif : unable to allocate Griffies operator diagnostics ' )   ;   RETURN 
    163             ENDIF 
     138            IF( lk_mpp   )   CALL mpp_sum ( ierr ) 
     139            IF( ierr > 0 )   CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 
    164140         ENDIF 
    165141      ENDIF 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90

    r2590 r2623  
    2828   PRIVATE 
    2929 
    30    PUBLIC   tra_ldf_lap       ! routine called by step.F90 
    31    PUBLIC   tra_ldf_lap_alloc ! routine called by nemogcm.F90 
     30   PUBLIC   tra_ldf_lap   ! routine called by step.F90 
    3231 
    3332   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients 
    … …  
    4342   !!---------------------------------------------------------------------- 
    4443CONTAINS 
    45  
    46    FUNCTION tra_ldf_lap_alloc() 
    47       !!---------------------------------------------------------------------- 
    48       !!                ***  ROUTINE tra_ldf_lap_alloc  *** 
    49       !!---------------------------------------------------------------------- 
    50       IMPLICIT none 
    51       INTEGER :: tra_ldf_lap_alloc 
    52       !!---------------------------------------------------------------------- 
    53  
    54       ALLOCATE(e1ur(jpi,jpj), e2vr(jpi,jpj), Stat=tra_ldf_lap_alloc) 
    55  
    56       IF( tra_ldf_lap_alloc /= 0)THEN 
    57          CALL ctl_warn('tra_ldf_lap_alloc: failed to allocate e1ur and e2vr arrays.') 
    58       END IF 
    59  
    60    END FUNCTION tra_ldf_lap_alloc 
    6144 
    6245   SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,      & 
    … …  
    7962      !!                harmonic mixing trend. 
    8063      !!---------------------------------------------------------------------- 
    81       USE oce         , ztu => ua   ! use ua as workspace 
    82       USE oce         , ztv => va   ! use va as workspace 
     64      USE oce ,  ztu => ua   ! use ua as workspace 
     65      USE oce ,  ztv => va   ! use va as workspace 
    8366      !! 
    8467      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    9073      !! 
    9174      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices 
    92       INTEGER  ::   iku, ikv             ! local integers 
     75      INTEGER  ::   iku, ikv, ierr       ! local integers 
    9376      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars 
    9477      !!---------------------------------------------------------------------- 
    … …  
    9881         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 
    9982         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     83         ! 
     84         ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr ) 
     85         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     86         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' ) 
     87         ! 
    10088         e1ur(:,:) = e2u(:,:) / e1u(:,:) 
    10189         e2vr(:,:) = e1v(:,:) / e2v(:,:) 
    … …  
    140128            DO jj = 2, jpjm1 
    141129               DO ji = fs_2, fs_jpim1   ! vector opt. 
    142                   zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
     130                  zbtr = 1._wp / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    143131                  ! horizontal diffusive trends added to the general tracer trends 
    144132                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2590 r2623  
    5555   PUBLIC   tra_nxt_fix   ! to be used in trcnxt 
    5656   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt 
    57    PUBLIC   tra_nxt_alloc ! used in nemogcm.F90 
    58  
    59    REAL(wp)                 ::   rbcp            ! Brown & Campana parameters for semi-implicit hpg 
    60    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 
     57 
     58   REAL(wp) ::   rbcp   ! Brown & Campana parameters for semi-implicit hpg 
    6159 
    6260   !! * Substitutions 
    … …  
    6462   !!---------------------------------------------------------------------- 
    6563   !! NEMO/OPA 3.3 , NEMO-Consortium (2010)  
    66    !! $Id $ 
    67    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     64   !! $Id$ 
     65   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    6866   !!---------------------------------------------------------------------- 
    6967CONTAINS 
    70  
    71    FUNCTION tra_nxt_alloc() 
    72       !!---------------------------------------------------------------------- 
    73       !!                ***  ROUTINE tran_xt_alloc  *** 
    74       !!---------------------------------------------------------------------- 
    75       IMPLICIT none 
    76       INTEGER tra_nxt_alloc 
    77       !!---------------------------------------------------------------------- 
    78  
    79       ALLOCATE(r2dt(jpk), Stat=tra_nxt_alloc) 
    80  
    81       IF(tra_nxt_alloc /= 0)THEN 
    82          CALL ctl_warn('tra_nxt_alloc: failed to allocate array r2dt.') 
    83       END IF 
    84  
    85    END FUNCTION tra_nxt_alloc 
    8668 
    8769   SUBROUTINE tra_nxt( kt ) 
    … …  
    121103         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    122104         ! 
    123          rbcp    = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)       ! Brown & Campana parameter for semi-implicit hpg 
     105         rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1. - atfp)      ! Brown & Campana parameter for semi-implicit hpg 
    124106      ENDIF 
    125107 
    … …  
    148130  
    149131      ! set time step size (Euler/Leapfrog) 
    150       IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt(:) =     rdttra(:)      ! at nit000             (Euler) 
    151       ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
     132      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dtra(:) =     rdttra(:)      ! at nit000             (Euler) 
     133      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dtra(:) = 2.* rdttra(:)      ! at nit000 or nit000+1 (Leapfrog) 
    152134      ENDIF 
    153135 
    … …  
    181163      IF( l_trdtra ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt      
    182164         DO jk = 1, jpkm1 
    183             zfact = 1.e0 / r2dt(jk)              
     165            zfact = 1.e0 / r2dtra(jk)              
    184166            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 
    185167            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90

    r2590 r2623  
    3434   PRIVATE 
    3535 
    36    PUBLIC tra_zdf      !  routine called by step.F90 
    37    PUBLIC tra_zdf_init !  routine called by opa.F90 
    38    PUBLIC tra_zdf_alloc!  routine called by nemogcm.F90 
     36   PUBLIC   tra_zdf        ! routine called by step.F90 
     37   PUBLIC   tra_zdf_init   ! routine called by nemogcm.F90 
    3938 
    40    INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    41       !                                ! defined from ln_zdf...  namlist logicals) 
    42    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 
    43       !                                              ! except at nit000 (=rdttra) if neuler=0 
     39   INTEGER ::   nzdf = 0   ! type vertical diffusion algorithm used (defined from ln_zdf...  namlist logicals) 
    4440 
    4541   !! * Substitutions 
    … …  
    5046   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    5147   !! $Id$ 
    52    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5349   !!---------------------------------------------------------------------- 
    54  
    5550CONTAINS 
    56  
    57    FUNCTION tra_zdf_alloc() 
    58       !!----------------------------------------------------------------------  
    59       !!                ***  ROUTINE tra_zdf_alloc  *** 
    60       !!----------------------------------------------------------------------  
    61       IMPLICIT none 
    62       INTEGER :: tra_zdf_alloc 
    63       !!---------------------------------------------------------------------- 
    64  
    65       ALLOCATE(r2dt(jpk), Stat=tra_zdf_alloc) 
    66  
    67       IF(tra_zdf_alloc /= 0)THEN 
    68          CALL ctl_warn('tra_zdf_alloc: failed to allocate r2dt array') 
    69       END IF 
    70  
    71    END FUNCTION tra_zdf_alloc 
    7251 
    7352   SUBROUTINE tra_zdf( kt ) 
    … …  
    8564      !                                          ! set time step 
    8665      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    87          r2dt(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
     66         r2dtra(:) =  rdttra(:)                          ! = rdtra (restarting with Euler time stepping) 
    8867      ELSEIF( kt <= nit000 + 1) THEN                ! at nit000 or nit000+1 
    89          r2dt(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
     68         r2dtra(:) = 2. * rdttra(:)                      ! = 2 rdttra (leapfrog) 
    9069      ENDIF 
    9170 
    … …  
    9675 
    9776      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    98       CASE ( 0 )    ;    CALL tra_zdf_exp( kt, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme  
    99       CASE ( 1 )    ;    CALL tra_zdf_imp( kt, 'TRA', r2dt,            tsb, tsa, jpts )  !   implicit scheme  
     77      CASE ( 0 )    ;    CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts )  !   explicit scheme  
     78      CASE ( 1 )    ;    CALL tra_zdf_imp( kt, 'TRA', r2dtra,            tsb, tsa, jpts )  !   implicit scheme  
    10079      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    101          CALL tra_zdf_exp( kt, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts ) 
     80         CALL tra_zdf_exp( kt, 'TRA', r2dtra, nn_zdfexp, tsb, tsa, jpts ) 
    10281         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask,               & 
    10382         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    104          CALL tra_zdf_imp( kt, 'TRA', r2dt,            tsb, tsa, jpts )  
     83         CALL tra_zdf_imp( kt, 'TRA', r2dtra,            tsb, tsa, jpts )  
    10584         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask,               & 
    10685         &             tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    … …  
    10988      IF( l_trdtra )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    11089         DO jk = 1, jpkm1 
    111             ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt(jk) ) - ztrdt(:,:,jk) 
    112             ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt(jk) ) - ztrds(:,:,jk) 
     90            ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dtra(jk) ) - ztrdt(:,:,jk) 
     91            ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 
    11392         END DO 
    11493         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt ) 
    … …  
    12099      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf  - Ta: ', mask1=tmask,               & 
    121100         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    122  
     101      ! 
    123102   END SUBROUTINE tra_zdf 
    124103 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r2616 r2623  
    9797      !!---------------------------------------------------------------------- 
    9898 
    99       IF(.NOT. wrk_use(2, 1))THEN 
    100          CALL ctl_stop('zdf_ric : requested workspace array unavailable.') 
    101          RETURN 
     99      IF(.NOT. wrk_use(2, 1) ) THEN 
     100         CALL ctl_stop('zdf_ric : requested workspace array unavailable')   ;   RETURN 
    102101      END IF 
    103102      !                                                ! =============== 
    … …  
    151150      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
    152151      ! 
    153       IF(.NOT. wrk_release(2, 1))THEN 
    154          CALL ctl_stop('zdf_ric : failed to release workspace array.') 
    155       END IF 
     152      IF(.NOT. wrk_release(2, 1) )   CALL ctl_stop('zdf_ric : failed to release workspace array') 
    156153      ! 
    157154   END SUBROUTINE zdf_ric 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2622 r2623  
    479479#endif 
    480480 
    481      USE traadv,       ONLY: tra_adv_alloc 
    482      USE traadv_cen2,  ONLY: tra_adv_cen2_alloc 
    483 #if   defined key_trabbl   ||   defined key_esopa 
    484      USE trabbl,       ONLY: tra_bbl_alloc 
    485 #endif 
    486 #if   defined key_tradmp   ||   defined key_esopa 
    487      USE tradmp,       ONLY: tra_dmp_alloc 
    488 #endif 
    489      USE traldf,       ONLY: tra_ldf_alloc 
    490 #if   defined key_ldfslp   ||   defined key_esopa 
    491      USE traldf_iso_grif,ONLY: tra_ldf_iso_grif_alloc 
    492 #endif 
    493      USE traldf_lap,   ONLY: tra_ldf_lap_alloc 
    494      USE tranxt,       ONLY: tra_nxt_alloc 
    495      USE trazdf,       ONLY: tra_zdf_alloc 
    496  
    497481     ! TOP-related alloc routines... 
    498482#if defined key_top 
    … …  
    559543      ierr = ierr + obc_oce_alloc() 
    560544#endif 
    561  
    562       ierr = ierr + tra_adv_alloc() 
    563       ierr = ierr + tra_adv_cen2_alloc() 
    564 #if defined key_trabbl   ||   defined key_esopa 
    565       ierr = ierr + tra_bbl_alloc() 
    566 #endif 
    567 #if defined key_tradmp   ||   defined key_esopa 
    568       ierr = ierr + tra_dmp_alloc() 
    569 #endif 
    570       ierr = ierr + tra_ldf_alloc() 
    571 #if defined key_ldfslp   ||   defined key_esopa 
    572       ierr = ierr + tra_ldf_iso_grif_alloc() 
    573 #endif 
    574       ierr = ierr + tra_ldf_lap_alloc() 
    575       ierr = ierr + tra_nxt_alloc() 
    576       ierr = ierr + tra_zdf_alloc() 
    577545 
    578546      ! Start of TOP-related alloc routines... 
Note: See TracChangeset for help on using the changeset viewer.