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 2618 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

Ignore:
Timestamp:
2011-02-26T13:31:38+01:00 (13 years ago)
Author:
gm
Message:

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

Location:
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90

    r2592 r2618  
    3535   PRIVATE 
    3636 
    37    PUBLIC   div_cur       ! routine called by step.F90 and istate.F90 
    38    PUBLIC   div_cur_alloc ! routine called by nemogcm.F90 
    39  
    40    ! These workspace arrays are not replaced by wrk_nemo because they  
    41    ! have extents greater than (jpi,jpj) 
    42    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwu   ! workspace 
    43    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwv   ! workspace 
     37   PUBLIC   div_cur    ! routine called by step.F90 and istate.F90 
    4438 
    4539   !! * Substitutions 
    … …  
    5347CONTAINS 
    5448 
    55    FUNCTION div_cur_alloc() 
    56       !!---------------------------------------------------------------------- 
    57       !!               ***  ROUTINE div_cur_alloc  *** 
    58       !!---------------------------------------------------------------------- 
    59       INTEGER :: div_cur_alloc 
    60       !!---------------------------------------------------------------------- 
    61  
    62       div_cur_alloc = 0 
    63  
    6449#if defined key_noslip_accurate 
    65       ALLOCATE(zwu( jpi, 1:jpj+2), zwv(-1:jpi+2, jpj), Stat=div_cur_alloc) 
    66 #endif 
    67  
    68       IF(div_cur_alloc /= 0)THEN 
    69          CALL ctl_warn('div_cur_alloc: failed to allocate arrays.') 
    70       END IF 
    71  
    72    END FUNCTION div_cur_alloc 
    73  
    74 #if defined key_noslip_accurate 
    75    !!---------------------------------------------------------------------- 
    76    !!   'key_noslip_accurate'                     2nd order centered scheme 
    77    !!                                                4th order at the coast 
     50   !!---------------------------------------------------------------------- 
     51   !!   'key_noslip_accurate'   2nd order interior + 4th order at the coast 
    7852   !!---------------------------------------------------------------------- 
    7953 
    … …  
    8357      !! 
    8458      !! ** Purpose :   compute the horizontal divergence and the relative 
    85       !!      vorticity at before and now time-step 
     59      !!              vorticity at before and now time-step 
    8660      !! 
    8761      !! ** Method  : I.  divergence : 
    … …  
    10781      !!              - update rotb , rotn , the before & now rel. vorticity 
    10882      !!---------------------------------------------------------------------- 
    109       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    110       ! 
    111       INTEGER ::   ji, jj, jk     ! dummy loop indices 
    112       INTEGER ::   ii, ij, jl     ! temporary integer 
    113       INTEGER ::   ijt, iju       ! temporary integer 
    114       REAL(wp) ::  zraur, zdep 
     83      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     84      ! 
     85      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwu   ! specific 2D workspace 
     86      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwv   ! specific 2D workspace 
     87      ! 
     88      INTEGER ::   ji, jj, jk, jl           ! dummy loop indices 
     89      INTEGER ::   ii, ij, ijt, iju, ierr   ! local integer 
     90      REAL(wp) ::  zraur, zdep              ! local scalar 
    11591      !!---------------------------------------------------------------------- 
    11692 
    … …  
    11995         IF(lwp) WRITE(numout,*) 'div_cur : horizontal velocity divergence and relative vorticity' 
    12096         IF(lwp) WRITE(numout,*) '~~~~~~~   NOT optimal for auto-tasking case' 
     97         ! 
     98         ALLOCATE( zwu( jpi, 1:jpj+2) , zwv(-1:jpi+2, jpj) , Stat=ierr ) 
     99         IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     100         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'div_cur : unable to allocate arrays' ) 
    121101      ENDIF 
    122102 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r2590 r2618  
    44   !! Ocean dynamics:  lateral viscosity trend 
    55   !!====================================================================== 
     6   !! History :  OPA  !  1997-07  (G. Madec)  Original code 
     7   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module 
     8   !!            2.0  !  2004-08  (C. Talandier) New trends organization 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_ldfslp   ||   defined key_esopa 
    711   !!---------------------------------------------------------------------- 
    … …  
    1216   !!   ldfguv         :  
    1317   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1518   USE oce             ! ocean dynamics and tracers 
    1619   USE dom_oce         ! ocean space and time domain 
    … …  
    2730   PRIVATE 
    2831 
    29    !! * Routine accessibility 
    30    PUBLIC dyn_ldf_bilapg       ! called by step.F90 
    31    PUBLIC dyn_ldf_bilapg_alloc ! called by nemogcm.F90 
    32  
    33    ! These are just workspace arrays but since they're (jpi,jpk) it's not 
    34    ! worth putting them in the wrk_nemo module. 
    35    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw, zdiu, zdiv 
    36    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  
     32   PUBLIC   dyn_ldf_bilapg       ! called by step.F90 
     33 
     34   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zfuw, zfvw , zdiu, zdiv   ! 2D workspace (ldfguv) 
     35   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zdju, zdj1u, zdjv, zdj1v  ! 2D workspace (ldfguv) 
    3736 
    3837   !! * Substitutions 
    … …  
    4746CONTAINS 
    4847 
    49    FUNCTION dyn_ldf_bilapg_alloc() 
     48   INTEGER FUNCTION dyn_ldf_bilapg_alloc() 
    5049      !!---------------------------------------------------------------------- 
    5150      !!               ***  ROUTINE dyn_ldf_bilapg_alloc  *** 
    5251      !!---------------------------------------------------------------------- 
    53       INTEGER :: dyn_ldf_bilapg_alloc 
    54  
    55       ALLOCATE(zfuw(jpi,jpk), zfvw(jpi,jpk),  zdiu(jpi,jpk), zdiv(jpi,jpk), & 
    56                zdju(jpi,jpk), zdj1u(jpi,jpk), zdjv(jpi,jpk), zdj1v(jpi,jpk),& 
    57                Stat = dyn_ldf_bilapg_alloc) 
    58  
    59       IF(dyn_ldf_bilapg_alloc /= 0)THEN 
    60          CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 
    61       END IF 
    62  
     52      ! 
     53      ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) ,     & 
     54         &      zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc) 
     55         ! 
     56      IF( dyn_ldf_bilapg_alloc /= 0 )   CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays') 
     57      ! 
    6358   END FUNCTION dyn_ldf_bilapg_alloc 
    6459 
    … …  
    9085      !!                biharmonic mixing trend. 
    9186      !!              - save the trend in (zwk3,zwk4) ('key_trddyn') 
    92       !! 
    93       !! History : 
    94       !!   8.0  !  97-07  (G. Madec)  Original code 
    95       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    96       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    97       !!---------------------------------------------------------------------- 
    98       !! * Modules used      
    99       USE oce, ONLY :    zwk3 => ta,   & ! use ta as 3D workspace    
    100                          zwk4 => sa      ! use sa as 3D workspace    
    101       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    102       ! work array used for rotated biharmonic operator on  
    103       ! tracers and/or momentum 
    104       USE wrk_nemo, ONLY: zwk1 => wrk_3d_1, &  
    105                           zwk2 => wrk_3d_2 
    106       !! * Arguments 
     87      !!---------------------------------------------------------------------- 
     88      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     89      USE wrk_nemo, ONLY:   zwk1 => wrk_3d_1 , zwk2 => wrk_3d_2   ! 3D workspace 
     90      USE oce     , ONLY:   zwk3 => ta       , zwk4 => sa         ! ta, sa used as 3D workspace    
     91      ! 
    10792      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    108  
    109       !! * Local declarations 
     93      ! 
    11094      INTEGER ::   ji, jj, jk                 ! dummy loop indices 
    11195      !!---------------------------------------------------------------------- 
    11296 
    113       IF(.NOT. wrk_use(3, 1,2))THEN 
    114          CALL ctl_stop('dyn_ldf_bilapg: requested workspace arrays unavailable.') 
    115          RETURN 
     97      IF( .NOT. wrk_use(3, 1,2) ) THEN 
     98         CALL ctl_stop('dyn_ldf_bilapg: requested workspace arrays unavailable.')   ;   RETURN 
    11699      END IF 
    117100 
    … …  
    122105         zwk1(:,:,:) = 0.e0   ;   zwk3(:,:,:) = 0.e0 
    123106         zwk2(:,:,:) = 0.e0   ;   zwk4(:,:,:) = 0.e0 
     107         !                                      ! allocate dyn_ldf_bilapg arrays 
     108         IF( dyn_ldf_bilapg_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays') 
    124109      ENDIF 
    125110 
    126111      ! Laplacian of (ub,vb) multiplied by ahm 
    127112      ! --------------------------------------   
    128       ! rotated harmonic operator applied to (ub,vb) 
    129       !     and multiply by ahmu, ahmv (output in (zwk1,zwk2) ) 
    130  
    131       CALL ldfguv ( ub, vb, zwk1, zwk2, 1 ) 
    132  
    133  
    134       ! Lateral boundary conditions on (zwk1,zwk2) 
    135       CALL lbc_lnk( zwk1, 'U', -1. ) 
    136       CALL lbc_lnk( zwk2, 'V', -1. ) 
    137  
     113      CALL ldfguv( ub, vb, zwk1, zwk2, 1 )      ! rotated harmonic operator applied to (ub,vb) 
     114      !                                         ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) ) 
     115      CALL lbc_lnk( zwk1, 'U', -1. )   ;   CALL lbc_lnk( zwk2, 'V', -1. )     ! Lateral boundary conditions 
    138116 
    139117      ! Bilaplacian of (ub,vb) 
    140118      ! ----------------------  
    141       ! rotated harmonic operator applied to (zwk1,zwk2) (output in (zwk3,zwk4) ) 
    142  
    143       CALL ldfguv ( zwk1, zwk2, zwk3, zwk4, 2 ) 
    144  
    145  
    146       ! Update the momentum trends           (j-slab :   2, jpj-1) 
     119      CALL ldfguv( zwk1, zwk2, zwk3, zwk4, 2 )  ! rotated harmonic operator applied to (zwk1,zwk2)  
     120      !                                         ! (output in (zwk3,zwk4) ) 
     121 
     122      ! Update the momentum trends 
    147123      ! -------------------------- 
    148       !                                                ! =============== 
    149       DO jj = 2, jpjm1                                 !  Vertical slab 
    150          !                                             ! =============== 
     124      DO jj = 2, jpjm1               ! add the diffusive trend to the general momentum trends 
    151125         DO jk = 1, jpkm1 
    152126            DO ji = 2, jpim1 
    153                ! add the diffusive trend to the general momentum trends 
    154127               ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk) 
    155128               va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk) 
    156129            END DO 
    157130         END DO 
    158          !                                             ! =============== 
    159       END DO                                           !   End of slab 
    160       !                                                ! =============== 
    161       IF(.NOT. wrk_release(3, 1,2))THEN 
    162          CALL ctl_stop('dyn_ldf_bilapg: failed to release workspace arrays.') 
    163       END IF 
     131      END DO 
     132      ! 
     133      IF( .NOT. wrk_release(3, 1,2) )   CALL ctl_stop('dyn_ldf_bilapg: failed to release workspace arrays') 
    164134      ! 
    165135   END SUBROUTINE dyn_ldf_bilapg 
    … …  
    206176      !!                          second order vertical derivative term) 
    207177      !!      'key_trddyn' defined: the trend is saved for diagnostics. 
    208       !! 
    209       !! History : 
    210       !!   8.0  !  97-07  (G. Madec)  Original code 
    211       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    212178      !!---------------------------------------------------------------------- 
    213179      USE wrk_nemo, ONLY: wrk_use, wrk_release 
    … …  
    216182      USE wrk_nemo, ONLY: zdkv => wrk_2d_7, zdk1v => wrk_2d_8 
    217183      !! 
    218       !! * Arguments 
    219       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::   & 
    220          pu, pv     ! momentum fields (before u and v for the 1st call, and 
    221       !             ! laplacian of these fields multiplied by ahm for the 2nd 
    222       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   & 
    223          plu, plv   ! partial harmonic operator applied to 
    224       !             ! pu and pv (all the components except 
    225       !             ! second order vertical derivative term) 
    226       INTEGER, INTENT( in ) ::   & 
    227          kahm       ! =1 the laplacian is multiplied by the eddy diffusivity coef. 
    228       !             ! =2 no multiplication 
    229  
    230       !! * Local declarations 
    231       INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    232       REAL(wp) ::   & 
    233          zabe1, zabe2, zcof1, zcof2,    &  ! temporary scalars 
    234          zcoef0, zcoef3, zcoef4 
    235       REAL(wp) ::   & 
    236          zbur, zbvr, zmkt, zmkf, zuav, zvav,    & 
    237          zuwslpi, zuwslpj, zvwslpi, zvwslpj 
    238       !!---------------------------------------------------------------------- 
    239  
    240       IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 
    241          CALL ctl_stop('dyn:ldfguv : requested workspace arrays unavailable.') 
    242          RETURN 
     184      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu , pv    ! 1st call: before horizontal velocity  
     185      !                                                               ! 2nd call: ahm x these fields 
     186      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) ::   plu, plv   ! partial harmonic operator applied to 
     187      !                                                               ! pu and pv (all the components except 
     188      !                                                               ! second order vertical derivative term) 
     189      INTEGER                         , INTENT(in   ) ::   kahm       ! =1 1st call ; =2 2nd call 
     190      ! 
     191      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     192      REAL(wp) ::   zabe1 , zabe2 , zcof1 , zcof2        ! local scalar 
     193      REAL(wp) ::   zcoef0, zcoef3, zcoef4               !   -      - 
     194      REAL(wp) ::   zbur, zbvr, zmkt, zmkf, zuav, zvav   !   -      - 
     195      REAL(wp) ::   zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      - 
     196      !!---------------------------------------------------------------------- 
     197 
     198      IF( .NOT. wrk_use(2, 1,2,3,4,5,6,7,8) ) THEN 
     199         CALL ctl_stop('dyn:ldfguv : requested workspace arrays unavailable.')   ;   RETURN 
    243200      END IF 
    244201      !                               ! ********** !   ! =============== 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90

    r2590 r2618  
    44   !! Ocean dynamics:  lateral viscosity trend 
    55   !!====================================================================== 
     6   !! History :  OPA  !  97-07  (G. Madec)  Original code 
     7   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module 
     8   !!             -   !  2004-08  (C. Talandier) New trends organization 
     9   !!            2.0  !  2005-11  (G. Madec)  s-coordinate: horizontal diffusion 
     10   !!---------------------------------------------------------------------- 
    611#if defined key_ldfslp   ||   defined key_esopa 
    712   !!---------------------------------------------------------------------- 
    … …  
    1217   !!                  tal s-coordinate laplacian operator. 
    1318   !!---------------------------------------------------------------------- 
    14    !! * Modules used 
    1519   USE oce             ! ocean dynamics and tracers 
    1620   USE dom_oce         ! ocean space and time domain 
    … …  
    2832   PRIVATE 
    2933 
    30    !! * Routine accessibility 
    31    PUBLIC dyn_ldf_iso           ! called by step.F90 
    32    PUBLIC dyn_ldf_iso_alloc     ! called by nemogcm.F90 
    33  
    34    ! These are just workspace arrays but because they are (jpi,jpk) in extent 
    35    ! we can't use the arrays in wrk_nemo for them 
    36    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u 
    37    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v 
     34   PUBLIC   dyn_ldf_iso           ! called by step.F90 
     35   PUBLIC   dyn_ldf_iso_alloc     ! called by nemogcm.F90 
     36 
     37   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zdiu, zdju, zdj1u   ! 2D workspace (dyn_ldf_iso)  
     38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfvw, zdiv, zdjv, zdj1v   !  -      - 
    3839 
    3940   !! * Substitutions 
    … …  
    4243#  include "vectopt_loop_substitute.h90" 
    4344   !!---------------------------------------------------------------------- 
    44    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     45   !! NEMO/OPA 3.3 , NEMO Consortium (2011) 
    4546   !! $Id$ 
    46    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    47    !!---------------------------------------------------------------------- 
    48  
     47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     48   !!---------------------------------------------------------------------- 
    4949CONTAINS 
    5050 
    51    FUNCTION dyn_ldf_iso_alloc() 
     51   INTEGER FUNCTION dyn_ldf_iso_alloc() 
    5252      !!---------------------------------------------------------------------- 
    5353      !!                  ***  ROUTINE dyn_ldf_iso_alloc  *** 
    5454      !!---------------------------------------------------------------------- 
    55       INTEGER :: dyn_ldf_iso_alloc 
    56       !!---------------------------------------------------------------------- 
    57  
    58       ALLOCATE(zfuw(jpi,jpk), zdiu(jpi,jpk), zdju(jpi,jpk), zdj1u(jpi,jpk), &  
    59                zfvw(jpi,jpk), zdiv(jpi,jpk), zdjv(jpi,jpk), zdj1v(jpi,jpk), & 
    60                Stat=dyn_ldf_iso_alloc) 
    61  
    62       IF(dyn_ldf_iso_alloc /= 0)THEN 
    63          CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 
    64       END IF 
    65  
     55      ! 
     56      ALLOCATE( zfuw(jpi,jpk) , zdiu(jpi,jpk) , zdju(jpi,jpk) , zdj1u(jpi,jpk) ,     &  
     57         &      zfvw(jpi,jpk) , zdiv(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_iso_alloc) 
     58         ! 
     59      IF( dyn_ldf_iso_alloc /= 0 )   CALL ctl_warn('dyn_ldf_iso_alloc: array allocate failed.') 
     60      ! 
    6661   END FUNCTION dyn_ldf_iso_alloc 
    6762 
    … …  
    110105      !!        Update (avmu,avmv) to accompt for the diagonal vertical component 
    111106      !!      of the rotated operator in dynzdf module 
    112       !! 
    113       !! History : 
    114       !!   8.0  !  97-07  (G. Madec)  Original code 
    115       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
    116       !!   9.0  !  04-08  (C. Talandier) New trends organization 
    117       !!        !  05-11  (G. Madec)  s-coordinate: horizontal diffusion 
    118107      !!---------------------------------------------------------------------- 
    119       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    120       USE wrk_nemo, ONLY: ziut => wrk_2d_1, zjuf  => wrk_2d_2, & ! temporary workspace 
    121                           zjvt => wrk_2d_3, zivf  => wrk_2d_4, &  
    122                           zdku => wrk_2d_5, zdk1u => wrk_2d_6, & 
    123                           zdkv => wrk_2d_7, zdk1v => wrk_2d_8 
    124       !! 
    125       !! * Arguments 
    126       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    127  
    128       !! * Local declarations 
    129       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    130       REAL(wp) ::   & 
    131          zabe1, zabe2, zcof1, zcof2,   &  ! temporary scalars 
    132          zmskt, zmskf, zbu, zbv,       & 
    133          zuah, zvah 
    134  
    135       REAL(wp) ::   & 
    136          zcoef0, zcoef3, zcoef4, zmkt, zmkf,   & 
    137          zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj 
    138  
     108      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     109      USE wrk_nemo, ONLY:   ziut  => wrk_2d_1 , zjuf  => wrk_2d_2 , zjvt => wrk_2d_3    ! 2D workspace 
     110      USE wrk_nemo, ONLY:   zivf  => wrk_2d_4 , zdku  => wrk_2d_5 , zdkv => wrk_2d_6    ! 2D workspace 
     111      USE wrk_nemo, ONLY:   zdk1u => wrk_2d_7 , zdk1v => wrk_2d_8 
     112      ! 
     113      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     114      ! 
     115      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     116      REAL(wp) ::   zabe1, zabe2, zcof1, zcof2                       ! local scalars 
     117      REAL(wp) ::   zmskt, zmskf, zbu, zbv, zuah, zvah               !   -      - 
     118      REAL(wp) ::   zcoef0, zcoef3, zcoef4, zmkt, zmkf               !   -      - 
     119      REAL(wp) ::   zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj   !   -      - 
    139120      !!---------------------------------------------------------------------- 
    140121 
    141       IF( .NOT. wrk_use(2, 1,2,3,4,5,6,7,8))THEN 
    142          CALL ctl_stop('dyn_ldf_iso: requested workspace arrays unavailable.') 
    143          RETURN 
     122      IF( .NOT. wrk_use(2, 1,2,3,4,5,6,7,8) ) THEN 
     123         CALL ctl_stop('dyn_ldf_iso: requested workspace arrays unavailable.')   ;   RETURN 
    144124      END IF 
    145125 
    … …  
    148128         IF(lwp) WRITE(numout,*) 'dyn_ldf_iso : iso-neutral laplacian diffusive operator or ' 
    149129         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   s-coordinate horizontal diffusive operator' 
     130         !                                      ! allocate dyn_ldf_bilap arrays 
     131         IF( dyn_ldf_iso_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_ldf_iso: failed to allocate arrays') 
    150132      ENDIF 
    151133 
    152 !     ! s-coordinate: Iso-level diffusion on momentum but not on tracer 
     134      ! s-coordinate: Iso-level diffusion on momentum but not on tracer 
    153135      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    154   
    155          ! set the slopes of iso-level 
    156          DO jk = 1, jpk 
     136         ! 
     137         DO jk = 1, jpk         ! set the slopes of iso-level 
    157138            DO jj = 2, jpjm1 
    158139               DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    164145            END DO 
    165146         END DO 
    166   
    167147         ! Lateral boundary conditions on the slopes 
    168148         CALL lbc_lnk( uslp , 'U', -1. )      ;      CALL lbc_lnk( vslp , 'V', -1. ) 
    … …  
    170150  
    171151!!bug 
    172          if( kt == nit000 ) then 
    173             IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  & 
    174                &                             ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj)) 
     152         IF( kt == nit000 ) then 
     153            IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)),  & 
     154               &                             ' wi', sqrt(MAXVAL(wslpi))     , ' wj', sqrt(MAXVAL(wslpj)) 
    175155         endif 
    176156!!end 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r2590 r2618  
    9191!!gm             they return the after velocity, not the trends (as in trazdf_imp...) 
    9292!!gm             In this case, change/simplify dynnxt 
    93  
    9493 
    9594 
    … …  
    181180      ENDIF 
    182181 
     182      !                        ! allocate dyn_spg arrays 
     183      IF( lk_dynspg_ts  .AND. dyn_spg_ts_alloc () /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_init: failed to allocate ts  arrays') 
     184 
    183185      !                        ! Control of surface pressure gradient scheme options 
    184186      ioptio = 0 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90

    r2528 r2618  
    4242   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4343   !!---------------------------------------------------------------------- 
    44  
    4544CONTAINS 
    4645 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2528 r2618  
    6565   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6666   !!---------------------------------------------------------------------- 
    67  
    6867CONTAINS 
    6968 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    r2590 r2618  
    55   !! Ocean dynamics: Define in memory surface pressure gradient variables 
    66   !!====================================================================== 
    7    !! History :  1.0  !  05-12  (C. Talandier, G. Madec)  Original code 
     7   !! History :  1.0  ! 2005-12  (C. Talandier, G. Madec)  Original code 
    88   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option 
    99   !!---------------------------------------------------------------------- 
    … …  
    3030#endif 
    3131 
    32 !!gm BUG : always required in _ts, only  some of them in vvl 
    33 !    #if   defined key_dynspg_ts   ||   defined key_esopa 
    34 !!gm end 
    35 #if   defined key_dynspg_ts   ||   defined key_vvl   ||   defined key_esopa 
    36   !                                                                !!! Time splitting scheme (sub-time step variables) 
    37    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_e  , va_e             ! barotropic velocities (after) 
    38    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshn_e, ssha_e, sshn_b   ! sea surface heigth (now, after, average) 
    39    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_e  , hv_e             ! now ocean depth ( = Ho+sshn_e ) 
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur_e , hvr_e            ! inverse of the now depth ( = 1/(Ho+sshn_e) ) 
    41 #endif 
    42  
    4332   !!---------------------------------------------------------------------- 
    44    !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
     33   !! NEMO/OPA 4.0 , LODYC-IPSL  (2011) 
    4534   !! $Id$  
    46    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     35   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4736   !!====================================================================== 
    48 CONTAINS 
    49  
    50   FUNCTION dynspg_oce_alloc() 
    51     IMPLICIT none 
    52     INTEGER :: dynspg_oce_alloc 
    53  
    54     dynspg_oce_alloc = 0 
    55  
    56 #if   defined key_dynspg_ts   ||   defined key_vvl   ||   defined key_esopa 
    57     ALLOCATE(ua_e(jpi,jpj),   va_e(jpi,jpj)  ,                  & 
    58              sshn_e(jpi,jpj), ssha_e(jpi,jpj), sshn_b(jpi,jpj), & 
    59              hu_e(jpi,jpj),   hv_e(jpi,jpj)  ,                  & 
    60              hur_e(jpi,jpj),  hvr_e(jpi,jpj) ,                  & 
    61              Stat=dynspg_oce_alloc) 
    62 #endif 
    63  
    64   END FUNCTION dynspg_oce_alloc 
    65  
    6637END MODULE dynspg_oce 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r2613 r2618  
    3838   USE prtctl          ! Print control 
    3939   USE in_out_manager  ! I/O manager 
    40    USE iom 
     40   USE iom             ! IOM library 
    4141   USE restart         ! only for lrst_oce 
    4242   USE zdf_oce 
    … …  
    5353   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse   ! (only used with een vorticity scheme) 
    5454 
    55    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_b, vn_b   ! now    averaged velocity 
    56    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b, vb_b   ! before averaged velocity 
    57  
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_b, vn_b       ! now    averaged velocity 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b, vb_b       ! before averaged velocity 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ua_e  , va_e     ! barotropic velocities (after) 
     58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshn_e, ssha_e   ! sea surface heigth (now, after, average) 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hu_e  , hv_e     ! now ocean depth ( = Ho+sshn_e ) 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hur_e , hvr_e    ! inverse of the now depth ( = 1/(Ho+sshn_e) ) 
    5861 
    5962   !! * Substitutions 
    6063#  include "domzgr_substitute.h90" 
    6164#  include "vectopt_loop_substitute.h90" 
    62    !!------------------------------------------------------------------------- 
    63    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     65   !!---------------------------------------------------------------------- 
     66   !! NEMO/OPA 4.0 , NEMO Consortium (2011) 
    6467   !! $Id$ 
    65    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    66    !!------------------------------------------------------------------------- 
    67  
     68   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     69   !!---------------------------------------------------------------------- 
    6870CONTAINS 
    6971 
    70    FUNCTION dyn_spg_ts_alloc() 
     72   INTEGER FUNCTION dyn_spg_ts_alloc() 
    7173      !!---------------------------------------------------------------------- 
    7274      !!                  ***  routine dyn_spg_ts_alloc  *** 
    7375      !!---------------------------------------------------------------------- 
    74       INTEGER ::   dyn_spg_ts_alloc   ! return value 
    75       !!---------------------------------------------------------------------- 
    76       ! 
    77       ALLOCATE(ftnw(jpi,jpj), ftne(jpi,jpj), ftsw(jpi,jpj), ftse(jpi,jpj), & 
    78          &      un_b(jpi,jpj), vn_b(jpi,jpj), ub_b(jpi,jpj), vb_b(jpi,jpj), & 
    79          &      STAT=dyn_spg_ts_alloc) 
    80          ! 
     76      ! 
     77      ALLOCATE( ftnw  (jpi,jpj) , ftne  (jpi,jpj) , ftsw  (jpi,jpj) , ftse (jpi,jpj) ,                                       & 
     78         &      un_b  (jpi,jpj) , vn_b  (jpi,jpj) , ub_b  (jpi,jpj) , vb_b (jpi,jpj) , ua_e  (jpi,jpj) , va_e  (jpi,jpj) ,   & 
     79         &      sshn_e(jpi,jpj) , ssha_e(jpi,jpj) , sshn_b(jpi,jpj) ,                                                        & 
     80         &      hu_e  (jpi,jpj) , hv_e  (jpi,jpj) , hur_e (jpi,jpj) , hvr_e(jpi,jpj) , STAT=dyn_spg_ts_alloc ) 
     81      IF(lk_mpp)   CALL mpp_sum( dyn_spg_ts_alloc ) 
     82      ! 
    8183   END FUNCTION dyn_spg_ts_alloc 
    8284 
    … …  
    122124      !! 
    123125      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    124       INTEGER  ::   icycle           ! temporary scalar 
    125  
    126       REAL(wp) ::   zraur, zcoef, z2dt_e, z2dt_b     ! temporary scalars 
    127       REAL(wp) ::   z1_8, zx1, zy1                   !    -         - 
    128       REAL(wp) ::   z1_4, zx2, zy2                   !     -         - 
    129       REAL(wp) ::   zu_spg, zu_cor, zu_sld, zu_asp   !     -         - 
    130       REAL(wp) ::   zv_spg, zv_cor, zv_sld, zv_asp   !     -         - 
     126      INTEGER  ::   icycle           ! local scalar 
     127      REAL(wp) ::   zraur, zcoef, z2dt_e, z2dt_b     ! local scalars 
     128      REAL(wp) ::   z1_8, zx1, zy1                   !   -      - 
     129      REAL(wp) ::   z1_4, zx2, zy2                   !   -      - 
     130      REAL(wp) ::   zu_spg, zu_cor, zu_sld, zu_asp   !   -      - 
     131      REAL(wp) ::   zv_spg, zv_cor, zv_sld, zv_asp   !   -      - 
    131132      !!---------------------------------------------------------------------- 
    132133 
    133134      IF(.NOT. wrk_use(2,  1, 2, 3, 4, 5, 6, 7, 8, 9,10,         & 
    134                           11,12,13,14,15,16,17,18,19,20,21))THEN 
    135          CALL ctl_stop('dyn_spg_ts: requested workspace arrays unavailable.') 
    136          RETURN 
     135                          11,12,13,14,15,16,17,18,19,20,21 ) ) THEN 
     136         CALL ctl_stop( 'dyn_spg_ts: requested workspace arrays unavailable.' )   ;   RETURN 
    137137      END IF 
    138138 
    … …  
    143143         IF(lwp) WRITE(numout,*) '~~~~~~~~~~   free surface with time splitting' 
    144144         IF(lwp) WRITE(numout,*) ' Number of sub cycle in 1 time-step (2 rdt) : icycle = ',  2*nn_baro 
     145         ! 
     146         !                                      ! allocate dyn_spg_ts arrays 
     147         IF( dyn_spg_ts_alloc() /= 0 )   CALL ctl_stop('STOP', 'dyn_spg_ts_alloc: failed to allocate arrays') 
    145148         ! 
    146149         CALL ts_rst( nit000, 'READ' )   ! read or initialize the following fields: un_b, vn_b   
    … …  
    484487         !                                                      !         - Correct the velocity 
    485488 
    486          IF( lk_obc               )   CALL obc_fla_ts 
     489         IF( lk_obc               )   CALL obc_fla_ts ( ua_e, va_e, sshn_e, ssha_e ) 
    487490         IF( lk_bdy .OR. ln_tides )   CALL bdy_dyn_fla( sshn_e )  
    488491         ! 

  • branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r2590 r2618  
    3939   PUBLIC   dyn_vor        ! routine called by step.F90 
    4040   PUBLIC   dyn_vor_init   ! routine called by opa.F90 
    41    PUBLIC   dyn_vor_alloc  ! routine called by nemogcm.F90 
    4241 
    4342   !                                             !!* Namelist namdyn_vor: vorticity term 
    … …  
    5150   INTEGER ::   nrvm = 2   ! =2 relative vorticity ; =3 metric term 
    5251   INTEGER ::   ntot = 4   ! =4 total vorticity (relative + planetary) ; =5 coriolis + metric term 
    53  
    54 !!$#if defined key_vvl 
    55 !!$   REAL(wp), DIMENSION(jpi,jpj,jpk)       ::   ze3f  
    56 !!$#else 
    57 !!$   REAL(wp), ALLOCATABLE, DIMENSION(jpi,jpj,jpk), SAVE ::   ze3f 
    58 !!$#endif 
    59    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ze3f 
    6052 
    6153   !! * Substitutions 
    … …  
    6759   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    6860   !!---------------------------------------------------------------------- 
    69  
    7061CONTAINS 
    71  
    72    FUNCTION dyn_vor_alloc() 
    73       !!---------------------------------------------------------------------- 
    74       !!              *** Routine dyn_vor_alloc *** 
    75       !!---------------------------------------------------------------------- 
    76       IMPLICIT none 
    77       INTEGER :: dyn_vor_alloc 
    78       !!---------------------------------------------------------------------- 
    79  
    80       ALLOCATE(ze3f(jpi,jpj,jpk), Stat=dyn_vor_alloc) 
    81  
    82       IF(dyn_vor_alloc /= 0 )THEN 
    83          CALL ctl_warn('dyn_vor_alloc: failed to allocate array ze3f.') 
    84       END IF 
    85  
    86    END FUNCTION dyn_vor_alloc 
    87  
    8862 
    8963   SUBROUTINE dyn_vor( kt ) 
    … …  
    584558      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    585559      !!---------------------------------------------------------------------- 
    586       USE wrk_nemo, ONLY: wrk_use, wrk_release 
    587       USE wrk_nemo, ONLY: zwx => wrk_2d_1,  zwy => wrk_2d_2,  zwz => wrk_2d_3  
    588       USE wrk_nemo, ONLY: ztnw => wrk_2d_4, ztne => wrk_2d_5, & 
    589                           ztsw => wrk_2d_6, ztse => wrk_2d_7 
    590       !! 
     560      USE wrk_nemo, ONLY:   wrk_use, wrk_release 
     561      USE wrk_nemo, ONLY:   zwx  => wrk_2d_1 , zwy  => wrk_2d_2 ,  zwz => wrk_2d_3  
     562      USE wrk_nemo, ONLY:   ztnw => wrk_2d_4 , ztne => wrk_2d_5  
     563      USE wrk_nemo, ONLY:   ztsw => wrk_2d_6 , ztse => wrk_2d_7 
     564#if defined key_vvl 
     565      USE wrk_nemo, ONLY:   ze3f => wrk_3d_1 
     566#endif 
     567      ! 
    591568      INTEGER , INTENT(in   )                         ::   kt     ! ocean time-step index 
    592569      INTEGER , INTENT(in   )                         ::   kvor   ! =ncor (planetary) ; =ntot (total) ; 
    … …  
    596573      !! 
    597574      INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    598       REAL(wp) ::   zfac12, zua, zva   ! temporary scalars 
    599       !!---------------------------------------------------------------------- 
    600  
    601       IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7))THEN 
    602          CALL ctl_stop('dyn:vor_een : requested workspace arrays unavailable.') 
    603          RETURN 
     575      INTEGER  ::   ierr               ! local integer 
     576      REAL(wp) ::   zfac12, zua, zva   ! local scalars 
     577#if ! defined key_vvl 
     578      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE ::   ze3f 
     579#endif 
     580      !!---------------------------------------------------------------------- 
     581 
     582      IF(.NOT. wrk_use(2, 1,2,3,4,5,6,7) .AND. .NOT. wrk_use(3, 1) ) THEN 
     583         CALL ctl_stop('dyn:vor_een : requested workspace arrays unavailable.')   ;   RETURN 
    604584      END IF 
    605585 
    … …  
    608588         IF(lwp) WRITE(numout,*) 'dyn:vor_een : vorticity term: energy and enstrophy conserving scheme' 
    609589         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     590         IF( .NOT.lk_vvl ) THEN 
     591            ALLOCATE( ze3f(jpi,jpj,jpk) , STAT=ierr ) 
     592            IF( lk_mpp    )   CALL mpp_sum ( ierr ) 
     593            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'dyn:vor_een : unable to allocate arrays' ) 
     594         ENDIF 
    610595      ENDIF 
    611596 
    … …  
    696681      END DO                                           !   End of slab 
    697682      !                                                ! =============== 
    698       IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7))THEN 
    699          CALL ctl_stop('dyn:vor_een : failed to release workspace arrays.') 
    700       END IF 
     683      IF(.NOT. wrk_release(2, 1,2,3,4,5,6,7) .AND.   & 
     684         .NOT. wrk_release(3, 1)  )   CALL ctl_stop('dyn:vor_een : failed to release workspace arrays') 
    701685      ! 
    702686   END SUBROUTINE vor_een 
Note: See TracChangeset for help on using the changeset viewer.