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

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

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

First attempt to put dynamic allocation on the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r2528 r2715  
    66   !! History :  OPA  !  1990-10  (B. Blanke)  Original code 
    77   !!            8.0  !  1997-05  (G. Madec)  vertical component of isopycnal 
    8    !!   NEMO     1.0  !  1002-08  (G. Madec)  F90: Free form and module 
     8   !!   NEMO     0.5  !  2002-08  (G. Madec)  F90: Free form and module 
    99   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps 
    1010   !!---------------------------------------------------------------------- 
     
    1919   USE zdf_oce         ! ocean vertical physics 
    2020   USE sbc_oce         ! surface boundary condition: ocean 
     21   USE lib_mpp         ! MPP library 
    2122   USE in_out_manager  ! I/O manager 
     23   USE lib_mpp         ! MPP library 
    2224 
    2325   IMPLICIT NONE 
     
    2527 
    2628   PUBLIC   dyn_zdf_exp   ! called by step.F90 
    27  
     29    
    2830   !! * Substitutions 
    2931#  include "domzgr_substitute.h90" 
     
    3234   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    3335   !! $Id$ 
    34    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     36   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3537   !!---------------------------------------------------------------------- 
    36  
    3738CONTAINS 
    3839 
     
    5354      !! ** Action : - Update (ua,va) with the vertical diffusive trend 
    5455      !!--------------------------------------------------------------------- 
     56      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     57      USE oce     , ONLY:   zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace 
     58      USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zww => wrk_3d_2   ! 3D workspace 
     59      ! 
    5560      INTEGER , INTENT(in) ::   kt     ! ocean time-step index 
    5661      REAL(wp), INTENT(in) ::   p2dt   ! time-step  
    57       !! 
    58       INTEGER ::   ji, jj, jk, jl                            ! dummy loop indices 
    59       REAL(wp) ::   zrau0r, zlavmr, zua, zva                 ! temporary scalars 
    60       REAL(wp), DIMENSION(jpi,jpk) ::   zwx, zwy, zwz, zww   ! 2D workspace 
     62      ! 
     63      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     64      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
    6165      !!---------------------------------------------------------------------- 
    6266 
    63       IF( kt == nit000 ) THEN 
    64          IF(lwp) WRITE(numout,*) 
    65          IF(lwp) WRITE(numout,*) 'dyn_zdf_exp : vertical momentum diffusion - explicit operator' 
    66          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 
     67      IF( wrk_in_use(3, 1,2) ) THEN 
     68         CALL ctl_stop('dyn_zdf_exp: requested workspace arrays unavailable')   ;   RETURN 
    6769      ENDIF 
    6870 
    69       zrau0r = 1. / rau0                              ! Local constant initialization 
     71      IF( kt == nit000 .AND. lwp ) THEN 
     72         WRITE(numout,*) 
     73         WRITE(numout,*) 'dyn_zdf_exp : vertical momentum diffusion - explicit operator' 
     74         WRITE(numout,*) '~~~~~~~~~~~ ' 
     75      ENDIF 
     76 
     77      zrau0r = 1. / rau0               ! Local constant initialization 
    7078      zlavmr = 1. / REAL( nn_zdfexp ) 
    7179 
    72       !                                               ! =============== 
    73       DO jj = 2, jpjm1                                !  Vertical slab 
    74          !                                            ! =============== 
    75          DO ji = 2, jpim1         ! Surface boundary condition 
    76             zwy(ji,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r 
    77             zww(ji,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r 
     80 
     81      DO jj = 2, jpjm1                 ! Surface boundary condition 
     82         DO ji = 2, jpim1 
     83            zwy(ji,jj,1) = ( utau_b(ji,jj) + utau(ji,jj) ) * zrau0r 
     84            zww(ji,jj,1) = ( vtau_b(ji,jj) + vtau(ji,jj) ) * zrau0r 
    7885         END DO   
    79          DO jk = 1, jpk         ! Initialization of x, z and contingently trends array 
     86      END DO   
     87      DO jk = 1, jpk                   ! Initialization of x, z and contingently trends array 
     88         DO jj = 2, jpjm1  
    8089            DO ji = 2, jpim1 
    81                zwx(ji,jk) = ub(ji,jj,jk) 
    82                zwz(ji,jk) = vb(ji,jj,jk) 
     90               zwx(ji,jj,jk) = ub(ji,jj,jk) 
     91               zwz(ji,jj,jk) = vb(ji,jj,jk) 
     92            END DO   
     93         END DO   
     94      END DO   
     95      ! 
     96      DO jl = 1, nn_zdfexp             ! Time splitting loop 
     97         ! 
     98         DO jk = 2, jpk                      ! First vertical derivative 
     99            DO jj = 2, jpjm1  
     100               DO ji = 2, jpim1 
     101                  zwy(ji,jj,jk) = avmu(ji,jj,jk) * ( zwx(ji,jj,jk-1) - zwx(ji,jj,jk) ) / fse3uw(ji,jj,jk)  
     102                  zww(ji,jj,jk) = avmv(ji,jj,jk) * ( zwz(ji,jj,jk-1) - zwz(ji,jj,jk) ) / fse3vw(ji,jj,jk) 
     103               END DO   
     104            END DO   
     105         END DO   
     106         DO jk = 1, jpkm1                    ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp 
     107            DO jj = 2, jpjm1  
     108               DO ji = 2, jpim1 
     109                  zua = zlavmr * ( zwy(ji,jj,jk) - zwy(ji,jj,jk+1) ) / fse3u(ji,jj,jk) 
     110                  zva = zlavmr * ( zww(ji,jj,jk) - zww(ji,jj,jk+1) ) / fse3v(ji,jj,jk) 
     111                  ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     112                  va(ji,jj,jk) = va(ji,jj,jk) + zva 
     113                  ! 
     114                  zwx(ji,jj,jk) = zwx(ji,jj,jk) + p2dt * zua * umask(ji,jj,jk) 
     115                  zwz(ji,jj,jk) = zwz(ji,jj,jk) + p2dt * zva * vmask(ji,jj,jk) 
     116               END DO   
    83117            END DO   
    84118         END DO   
    85119         ! 
    86          DO jl = 1, nn_zdfexp     ! Time splitting loop 
    87             ! 
    88             DO jk = 2, jpk            ! First vertical derivative 
    89                DO ji = 2, jpim1 
    90                   zwy(ji,jk) = avmu(ji,jj,jk) * ( zwx(ji,jk-1) - zwx(ji,jk) ) / fse3uw(ji,jj,jk)  
    91                   zww(ji,jk) = avmv(ji,jj,jk) * ( zwz(ji,jk-1) - zwz(ji,jk) ) / fse3vw(ji,jj,jk) 
    92                END DO   
    93             END DO   
    94             DO jk = 1, jpkm1          ! Second vertical derivative and trend estimation at kt+l*rdt/nn_zdfexp 
    95                DO ji = 2, jpim1 
    96                   zua = zlavmr * ( zwy(ji,jk) - zwy(ji,jk+1) ) / fse3u(ji,jj,jk) 
    97                   zva = zlavmr * ( zww(ji,jk) - zww(ji,jk+1) ) / fse3v(ji,jj,jk) 
    98                   ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
    99                   va(ji,jj,jk) = va(ji,jj,jk) + zva 
    100                   ! 
    101                   zwx(ji,jk) = zwx(ji,jk) + p2dt * zua * umask(ji,jj,jk) 
    102                   zwz(ji,jk) = zwz(ji,jk) + p2dt * zva * vmask(ji,jj,jk) 
    103                END DO   
    104             END DO   
    105             ! 
    106          END DO   
    107          !                                            ! =============== 
    108       END DO                                          !   End of slab 
    109       !                                               ! =============== 
     120      END DO                           ! End of time splitting 
     121      ! 
     122      IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf_exp: failed to release workspace arrays') 
     123      ! 
    110124   END SUBROUTINE dyn_zdf_exp 
    111125 
Note: See TracChangeset for help on using the changeset viewer.