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 8568 for branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

Ignore:
Timestamp:
2017-09-27T16:29:24+02:00 (7 years ago)
Author:
gm
Message:

#1911 (ENHANCE-09): PART I.2 - _NONE option + remove zts + see associated wiki page

Location:
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM
Files:
14 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r7646 r8568  
    222222      !!---------------------------------------------------------------------- 
    223223      ! 
    224       IF( nn_timing == 1 )  CALL timing_start('day') 
     224      IF( ln_timing )   CALL timing_start('day') 
    225225      ! 
    226226      zprec = 0.1 / rday 
    … …  
    276276      IF( lrst_oce         ) CALL day_rst( kt, 'WRITE' )      ! write day restart information 
    277277      ! 
    278       IF( nn_timing == 1 )  CALL timing_stop('day') 
     278      IF( ln_timing )   CALL timing_stop('day') 
    279279      ! 
    280280   END SUBROUTINE day 
    … …  
    402402         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
    403403         !                                                                     ! the begining of the run [s] 
    404     CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
     404         CALL iom_rstput( kt, nitrst, numrow, 'ntime'  , REAL( nn_time0, wp) ) ! time 
    405405      ENDIF 
    406406      ! 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/depth_e3.F90

    r7753 r8568  
    2020   USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
    2121   USE lib_mpp           ! distributed memory computing library 
    22    USE wrk_nemo          ! Memory allocation 
    2322   USE timing            ! Timing 
    2423 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r7822 r8568  
    4545   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
    4646   USE lib_mpp        ! distributed memory computing library 
    47    USE wrk_nemo       ! Memory Allocation 
    4847   USE timing         ! Timing 
    4948 
    … …  
    8382      !!---------------------------------------------------------------------- 
    8483      ! 
    85       IF( nn_timing == 1 )   CALL timing_start('dom_init') 
     84      IF( ln_timing )   CALL timing_start('dom_init') 
    8685      ! 
    8786      IF(lwp) THEN         ! Ocean domain Parameters (control print) 
    … …  
    199198      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file 
    200199      ! 
    201       IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
     200      IF( ln_timing )   CALL timing_stop('dom_init') 
    202201      ! 
    203202   END SUBROUTINE dom_init 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r7753 r8568  
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dom_hgr') 
     81      IF( ln_timing )   CALL timing_start('dom_hgr') 
    8282      ! 
    8383      IF(lwp) THEN 
    … …  
    152152      ! 
    153153      ! 
    154       IF( nn_timing == 1 )  CALL timing_stop('dom_hgr') 
     154      IF( ln_timing )   CALL timing_stop('dom_hgr') 
    155155      ! 
    156156   END SUBROUTINE dom_hgr 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r7753 r8568  
    3030   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3131   USE lib_mpp        ! Massively Parallel Processing library 
    32    USE wrk_nemo       ! Memory allocation 
    3332   USE timing         ! Timing 
    3433 
    … …  
    9291      INTEGER  ::   iktop, ikbot   !   -       - 
    9392      INTEGER  ::   ios, inum 
    94       REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace 
     93      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9594      !! 
    9695      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
    … …  
    104103      !!--------------------------------------------------------------------- 
    105104      ! 
    106       IF( nn_timing == 1 )  CALL timing_start('dom_msk') 
     105      IF( ln_timing )   CALL timing_start('dom_msk') 
    107106      ! 
    108107      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    … …  
    248247      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
    249248         ! 
    250          CALL wrk_alloc( jpi,jpj,   zwf ) 
     249         ALLOCATE( zwf(jpi,jpj) ) 
    251250         ! 
    252251         DO jk = 1, jpk 
    … …  
    278277         END DO 
    279278         ! 
    280          CALL wrk_dealloc( jpi,jpj,  zwf ) 
     279         DEALLOCATE( zwf ) 
    281280         ! 
    282281         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    … …  
    292291      ! 
    293292      ! 
    294       IF( nn_timing == 1 )  CALL timing_stop('dom_msk') 
     293      IF( ln_timing )   CALL timing_stop('dom_msk') 
    295294      ! 
    296295   END SUBROUTINE dom_msk 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90

    r7646 r8568  
    1111   !!---------------------------------------------------------------------- 
    1212   USE dom_oce        ! ocean space and time domain 
     13   ! 
    1314   USE in_out_manager ! I/O manager 
    1415   USE lib_mpp        ! for mppsum 
    15    USE wrk_nemo       ! Memory allocation 
    1616   USE timing         ! Timing 
    1717 
    … …  
    4545      INTEGER , DIMENSION(2) ::   iloc 
    4646      REAL(wp)               ::   zlon, zmini 
    47       REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist 
     47      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist 
    4848      !!-------------------------------------------------------------------- 
    4949      ! 
    50       IF( nn_timing == 1 )  CALL timing_start('dom_ngb') 
    51       ! 
    52       CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist ) 
     50      IF( ln_timing )   CALL timing_start('dom_ngb') 
    5351      ! 
    5452      zmask(:,:) = 0._wp 
    … …  
    7977      ENDIF 
    8078      ! 
    81       CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist ) 
    82       ! 
    83       IF( nn_timing == 1 )  CALL timing_stop('dom_ngb') 
     79      IF( ln_timing )   CALL timing_stop('dom_ngb') 
    8480      ! 
    8581   END SUBROUTINE dom_ngb 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7753 r8568  
    66   !! History :  2.0  !  2006-06  (B. Levier, L. Marie)  original code 
    77   !!            3.1  !  2009-02  (G. Madec, M. Leclair, R. Benshila)  pure z* coordinate 
    8    !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: 
    9    !!                                          vvl option includes z_star and z_tilde coordinates 
     8   !!            3.3  !  2011-10  (M. Leclair) totally rewrote domvvl: vvl option includes z_star and z_tilde coordinates 
    109   !!            3.6  !  2014-11  (P. Mathiot) add ice shelf capability 
    1110   !!---------------------------------------------------------------------- 
    … …  
    3130   USE lib_mpp         ! distributed memory computing library 
    3231   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    33    USE wrk_nemo        ! Memory allocation 
    3432   USE timing          ! Timing 
    3533 
    … …  
    122120      !!---------------------------------------------------------------------- 
    123121      ! 
    124       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_init') 
     122      IF( ln_timing )   CALL timing_start('dom_vvl_init') 
    125123      ! 
    126124      IF(lwp) WRITE(numout,*) 
    … …  
    242240      ENDIF 
    243241      ! 
    244       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_init') 
     242      IF( ln_timing )   CALL timing_stop('dom_vvl_init') 
    245243      ! 
    246244   END SUBROUTINE dom_vvl_init 
    … …  
    276274      REAL(wp)               ::   z2dt, z_tmin, z_tmax  ! local scalars 
    277275      LOGICAL                ::   ll_do_bclinic         ! local logical 
    278       REAL(wp), POINTER, DIMENSION(:,:,:) ::   ze3t 
    279       REAL(wp), POINTER, DIMENSION(:,:  ) ::   zht, z_scale, zwu, zwv, zhdiv 
     276      REAL(wp), DIMENSION(jpi,jpj)     ::   zht, z_scale, zwu, zwv, zhdiv 
     277      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
    280278      !!---------------------------------------------------------------------- 
    281279      ! 
    282280      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    283281      ! 
    284       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_sf_nxt') 
    285       ! 
    286       CALL wrk_alloc( jpi,jpj,zht,   z_scale, zwu, zwv, zhdiv ) 
    287       CALL wrk_alloc( jpi,jpj,jpk,   ze3t ) 
    288  
     282      IF( ln_timing )   CALL timing_start('dom_vvl_sf_nxt') 
     283      ! 
    289284      IF( kt == nit000 ) THEN 
    290285         IF(lwp) WRITE(numout,*) 
    … …  
    543538      r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    544539      ! 
    545       CALL wrk_dealloc( jpi,jpj,       zht, z_scale, zwu, zwv, zhdiv ) 
    546       CALL wrk_dealloc( jpi,jpj,jpk,   ze3t ) 
    547       ! 
    548       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_sf_nxt') 
     540      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_nxt') 
    549541      ! 
    550542   END SUBROUTINE dom_vvl_sf_nxt 
    … …  
    583575      IF( ln_linssh )   RETURN      ! No calculation in linear free surface 
    584576      ! 
    585       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_sf_swp') 
     577      IF( ln_timing )   CALL timing_start('dom_vvl_sf_swp') 
    586578      ! 
    587579      IF( kt == nit000 )   THEN 
    … …  
    657649      ! write restart file 
    658650      ! ================== 
    659       IF( lrst_oce )   CALL dom_vvl_rst( kt, 'WRITE' ) 
    660       ! 
    661       IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_sf_swp') 
     651      IF( lrst_oce  )   CALL dom_vvl_rst( kt, 'WRITE' ) 
     652      ! 
     653      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_swp') 
    662654      ! 
    663655   END SUBROUTINE dom_vvl_sf_swp 
    … …  
    683675      !!---------------------------------------------------------------------- 
    684676      ! 
    685       IF( nn_timing == 1 )   CALL timing_start('dom_vvl_interpol') 
     677      IF( ln_timing )   CALL timing_start('dom_vvl_interpol') 
    686678      ! 
    687679      IF(ln_wd) THEN 
    … …  
    770762      END SELECT 
    771763      ! 
    772       IF( nn_timing == 1 )   CALL timing_stop('dom_vvl_interpol') 
     764      IF( ln_timing )   CALL timing_stop('dom_vvl_interpol') 
    773765      ! 
    774766   END SUBROUTINE dom_vvl_interpol 
    … …  
    794786      !!---------------------------------------------------------------------- 
    795787      ! 
    796       IF( nn_timing == 1 )  CALL timing_start('dom_vvl_rst') 
     788      IF( ln_timing )   CALL timing_start('dom_vvl_rst') 
     789      ! 
    797790      IF( TRIM(cdrw) == 'READ' ) THEN        ! Read/initialise  
    798791         !                                   ! =============== 
    … …  
    947940      ENDIF 
    948941      ! 
    949       IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst') 
     942      IF( ln_timing )   CALL timing_stop('dom_vvl_rst') 
    950943      ! 
    951944   END SUBROUTINE dom_vvl_rst 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r7646 r8568  
    2424   USE lbclnk          ! lateral boundary conditions - mpp exchanges 
    2525   USE lib_mpp         ! MPP library 
    26    USE wrk_nemo        ! Memory allocation 
    2726   USE timing          ! Timing 
    2827 
    … …  
    7574      INTEGER           ::   izco, izps, isco, icav 
    7675      !                                
    77       REAL(wp), POINTER, DIMENSION(:,:)   ::   zprt, zprw     ! 2D workspace 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdepu, zdepv   ! 3D workspace 
    79       !!---------------------------------------------------------------------- 
    80       ! 
    81       IF( nn_timing == 1 )  CALL timing_start('dom_wri') 
    82       ! 
    83       CALL wrk_alloc( jpi,jpj,       zprt , zprw  ) 
    84       CALL wrk_alloc( jpi,jpj,jpk,   zdepu, zdepv ) 
     76      REAL(wp), DIMENSION(jpi,jpj)     ::   zprt, zprw     ! 2D workspace 
     77      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepu, zdepv   ! 3D workspace 
     78      !!---------------------------------------------------------------------- 
     79      ! 
     80      IF( ln_timing )   CALL timing_start('dom_wri') 
    8581      ! 
    8682      IF(lwp) WRITE(numout,*) 
    … …  
    206202      !                                     ! ============================ 
    207203      ! 
    208       CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 
    209       CALL wrk_dealloc( jpi, jpj, jpk, zdepu, zdepv ) 
    210       ! 
    211       IF( nn_timing == 1 )  CALL timing_stop('dom_wri') 
     204      IF( ln_timing )   CALL timing_stop('dom_wri') 
    212205      ! 
    213206   END SUBROUTINE dom_wri 
    … …  
    229222      INTEGER  ::  ji       ! dummy loop indices 
    230223      LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    231       REAL(wp), POINTER, DIMENSION(:,:) :: ztstref 
    232       !!---------------------------------------------------------------------- 
    233       ! 
    234       IF( nn_timing == 1 )  CALL timing_start('dom_uniq') 
    235       ! 
    236       CALL wrk_alloc( jpi, jpj, ztstref ) 
     224      REAL(wp), DIMENSION(jpi,jpj) ::   ztstref 
     225      !!---------------------------------------------------------------------- 
     226      ! 
     227      IF( ln_timing )   CALL timing_start('dom_uniq') 
    237228      ! 
    238229      ! build an array with different values for each element  
    … …  
    250241      puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    251242      ! 
    252       CALL wrk_dealloc( jpi, jpj, ztstref ) 
    253       ! 
    254       IF( nn_timing == 1 )  CALL timing_stop('dom_uniq') 
     243      IF( ln_timing )   CALL timing_stop('dom_uniq') 
    255244      ! 
    256245   END SUBROUTINE dom_uniq 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r7753 r8568  
    3636   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
    3737   USE lib_mpp        ! distributed memory computing library 
    38    USE wrk_nemo       ! Memory allocation 
    3938   USE timing         ! Timing 
    4039 
    … …  
    7776      !!---------------------------------------------------------------------- 
    7877      ! 
    79       IF( nn_timing == 1 )   CALL timing_start('dom_zgr') 
     78      IF( ln_timing )   CALL timing_start('dom_zgr') 
    8079      ! 
    8180      IF(lwp) THEN                     ! Control print 
    … …  
    164163      ENDIF 
    165164      ! 
    166       IF( nn_timing == 1 )  CALL timing_stop('dom_zgr') 
     165      IF( ln_timing )   CALL timing_stop('dom_zgr') 
    167166      ! 
    168167   END SUBROUTINE dom_zgr 
    … …  
    284283      ! 
    285284      INTEGER ::   ji, jj   ! dummy loop indices 
    286       REAL(wp), POINTER, DIMENSION(:,:) ::  zk 
    287       !!---------------------------------------------------------------------- 
    288       ! 
    289       IF( nn_timing == 1 )  CALL timing_start('zgr_top_bot') 
    290       ! 
    291       CALL wrk_alloc( jpi,jpj,   zk ) 
     285      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     286      !!---------------------------------------------------------------------- 
     287      ! 
     288      IF( ln_timing )   CALL timing_start('zgr_top_bot') 
    292289      ! 
    293290      IF(lwp) WRITE(numout,*) 
    … …  
    319316      zk(:,:) = REAL( mbkv(:,:), wp )   ;   CALL lbc_lnk( zk, 'V', 1. )   ;   mbkv(:,:) = MAX( INT( zk(:,:) ), 1 ) 
    320317      ! 
    321       CALL wrk_dealloc( jpi,jpj,   zk ) 
    322       ! 
    323       IF( nn_timing == 1 )  CALL timing_stop('zgr_top_bot') 
     318      IF( ln_timing )   CALL timing_stop('zgr_top_bot') 
    324319      ! 
    325320   END SUBROUTINE zgr_top_bot 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r7753 r8568  
    1616   !!---------------------------------------------------------------------- 
    1717   USE oce             ! ocean dynamics and tracers 
     18   USE phycst          ! physical constants 
    1819   USE dom_oce         ! ocean space and time domain 
    1920   USE fldread         ! read input fields 
     21   ! 
    2022   USE in_out_manager  ! I/O manager 
    21    USE phycst          ! physical constants 
    2223   USE lib_mpp         ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2424   USE timing          ! Timing 
    2525 
    … …  
    6262      !!---------------------------------------------------------------------- 
    6363      ! 
    64       IF( nn_timing == 1 )  CALL timing_start('dta_tsd_init') 
     64      IF( ln_timing )   CALL timing_start('dta_tsd_init') 
    6565      ! 
    6666      !  Initialisation 
    … …  
    120120      ENDIF 
    121121      ! 
    122       IF( nn_timing == 1 )  CALL timing_stop('dta_tsd_init') 
     122      IF( ln_timing )   CALL timing_stop('dta_tsd_init') 
    123123      ! 
    124124   END SUBROUTINE dta_tsd_init 
    … …  
    145145      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    146146      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    147       REAL(wp)::   zl, zi 
    148       REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace 
    149       !!---------------------------------------------------------------------- 
    150       ! 
    151       IF( nn_timing == 1 )  CALL timing_start('dta_tsd') 
     147      REAL(wp)::   zl, zi                             ! local scalars 
     148      REAL(wp), DIMENSION(jpk) ::  ztp, zsp   ! 1D workspace 
     149      !!---------------------------------------------------------------------- 
     150      ! 
     151      IF( ln_timing )   CALL timing_start('dta_tsd') 
    152152      ! 
    153153      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==! 
    … …  
    185185      ! 
    186186      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    187          ! 
    188          CALL wrk_alloc( jpk, ztp, zsp ) 
    189187         ! 
    190188         IF( kt == nit000 .AND. lwp )THEN 
    … …  
    222220         END DO 
    223221         !  
    224          CALL wrk_dealloc( jpk, ztp, zsp ) 
    225          !  
    226222      ELSE                                !==   z- or zps- coordinate   ==! 
    227223         !                              
    … …  
    260256      ENDIF 
    261257      ! 
    262       IF( nn_timing == 1 )  CALL timing_stop('dta_tsd') 
     258      IF( ln_timing )   CALL timing_stop('dta_tsd') 
    263259      ! 
    264260   END SUBROUTINE dta_tsd 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

    r7646 r8568  
    1313   !!   iscpl_div      : correction of divergence to keep volume conservation 
    1414   !!---------------------------------------------------------------------- 
     15   USE oce             ! global tra/dyn variable 
    1516   USE dom_oce         ! ocean space and time domain 
    1617   USE domwri          ! ocean space and time domain 
     18   USE domngb          !  
    1719   USE phycst          ! physical constants 
    1820   USE sbc_oce         ! surface boundary condition variables 
    19    USE oce             ! global tra/dyn variable 
     21   USE iscplini        !  
     22   ! 
    2023   USE in_out_manager  ! I/O manager 
    2124   USE lib_mpp         ! MPP library 
    2225   USE lib_fortran     ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2426   USE lbclnk          ! 
    25    USE domngb          ! 
    26    USE iscplini 
    2727 
    2828   IMPLICIT NONE 
    … …  
    5656      REAL(wp), DIMENSION(:,:,:  ), INTENT(out) :: pvol_flx    !! corrective flux to have volume conservation 
    5757      REAL(wp),                     INTENT(in ) :: prdt_iscpl  !! coupling period  
    58       !! 
    59       INTEGER :: ji, jj, jk                                    !! loop index 
    60       INTEGER :: jip1, jim1, jjp1, jjm1 
    61       !! 
    62       REAL(wp):: summsk, zsum, zsum1, zarea, zsumn, zsumb 
    63       REAL(wp):: r1_rdtiscpl 
    64       REAL(wp):: zjip1_ratio  , zjim1_ratio  , zjjp1_ratio  , zjjm1_ratio 
    65       !! 
    66       REAL(wp):: zde3t, zdtem, zdsal 
    67       REAL(wp), DIMENSION(:,:), POINTER :: zdssh 
    68       !! 
    69       REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat 
    70       REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal 
    71       INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts 
     58      ! 
     59      INTEGER  ::   ji  , jj  , jk           ! loop index 
     60      INTEGER  ::   jip1, jim1, jjp1, jjm1 
     61      REAL(wp) ::   summsk, zsum , zsumn, zjip1_ratio  , zjim1_ratio, zdtem, zde3t, z1_rdtiscpl 
     62      REAL(wp) ::   zarea , zsum1, zsumb, zjjp1_ratio  , zjjm1_ratio, zdsal 
     63      REAL(wp), DIMENSION(jpi,jpj)        ::   zdssh   ! workspace 
     64      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zlon, zlat 
     65      REAL(wp), DIMENSION(:), ALLOCATABLE ::   zcorr_vol, zcorr_tem, zcorr_sal 
     66      INTEGER , DIMENSION(:), ALLOCATABLE ::   ixpts, iypts, izpts, inpts 
    7267      INTEGER :: jpts, npts 
    73  
    74       CALL wrk_alloc(jpi,jpj, zdssh ) 
     68      !!---------------------------------------------------------------------- 
    7569 
    7670      ! get imbalance (volume heat and salt) 
    7771      ! initialisation difference 
    78       zde3t = 0.0_wp; zdsal = 0.0_wp ; zdtem = 0.0_wp 
     72      zde3t = 0._wp   ;   zdsal = 0._wp   ;   zdtem = 0._wp 
    7973 
    8074      ! initialisation correction term 
    81       pvol_flx(:,:,:  ) = 0.0_wp 
    82       pts_flx (:,:,:,:) = 0.0_wp 
     75      pvol_flx(:,:,:  ) = 0._wp 
     76      pts_flx (:,:,:,:) = 0._wp 
    8377       
    84       r1_rdtiscpl = 1._wp / prdt_iscpl  
     78      z1_rdtiscpl = 1._wp / prdt_iscpl  
    8579 
    8680      ! mask tsn and tsb  
    87       tsb(:,:,:,jp_tem)=tsb(:,:,:,jp_tem)*ptmask_b(:,:,:); tsn(:,:,:,jp_tem)=tsn(:,:,:,jp_tem)*tmask(:,:,:); 
    88       tsb(:,:,:,jp_sal)=tsb(:,:,:,jp_sal)*ptmask_b(:,:,:); tsn(:,:,:,jp_sal)=tsn(:,:,:,jp_sal)*tmask(:,:,:); 
     81      tsb(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) * ptmask_b(:,:,:) 
     82      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) *  tmask  (:,:,:) 
     83      tsb(:,:,:,jp_sal) = tsb(:,:,:,jp_sal) * ptmask_b(:,:,:) 
     84      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) *  tmask  (:,:,:) 
    8985 
    9086      !============================================================================== 
    … …  
    118114 
    119115                  ! volume, heat and salt differences in each cell  
    120                   pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * r1_rdtiscpl 
    121                   pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * r1_rdtiscpl  
    122                   pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * r1_rdtiscpl 
     116                  pvol_flx(ji,jj,jk)       =   pvol_flx(ji,jj,jk)        + zde3t * z1_rdtiscpl 
     117                  pts_flx (ji,jj,jk,jp_sal)=   pts_flx (ji,jj,jk,jp_sal) + zdsal * z1_rdtiscpl  
     118                  pts_flx (ji,jj,jk,jp_tem)=   pts_flx (ji,jj,jk,jp_tem) + zdtem * z1_rdtiscpl 
    123119 
    124120                  ! case where we close a cell: check if the neighbour cells are wet  
    … …  
    190186      ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point  
    191187      ! allocation and initialisation of the list of problematic point 
    192       ALLOCATE(inpts(jpnij)) 
    193       inpts(:)=0 
     188      ALLOCATE( inpts(jpnij) ) 
     189      inpts(:) = 0 
    194190 
    195191      ! fill narea location with the number of problematic point 
    … …  
    287283      CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 
    288284      CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 
    289  
    290       ! deallocate variables 
    291       CALL wrk_dealloc(jpi,jpj, zdssh )  
    292  
     285      ! 
    293286   END SUBROUTINE iscpl_cons 
     287 
    294288 
    295289   SUBROUTINE iscpl_div( phdivn ) 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplini.F90

    r7646 r8568  
    1111   !!   iscpl_alloc    : allocation of correction variables 
    1212   !!---------------------------------------------------------------------- 
     13   USE oce             ! global tra/dyn variable 
    1314   USE dom_oce         ! ocean space and time domain 
    14    USE oce             ! global tra/dyn variable 
     15   ! 
    1516   USE lib_mpp         ! MPP library 
    1617   USE lib_fortran     ! MPP library 
    … …  
    4748   END FUNCTION iscpl_alloc 
    4849 
     50 
    4951   SUBROUTINE iscpl_init() 
     52      !!---------------------------------------------------------------------- 
    5053      INTEGER ::   ios           ! Local integer output status for namelist read 
    51       NAMELIST/namsbc_iscpl/nn_fiscpl,ln_hsb,nn_drown 
     54      NAMELIST/namsbc_iscpl/ nn_fiscpl, ln_hsb, nn_drown 
    5255      !!---------------------------------------------------------------------- 
    53       !                                   ! ============ 
    54       !                                   !   Namelist 
    55       !                                   ! ============ 
    5656      ! 
    5757      nn_fiscpl = 0 
    … …  
    7979         WRITE(numout,*) ' coupling time step                       = ', rdt_iscpl 
    8080         WRITE(numout,*) ' number of call of the extrapolation loop = ', nn_drown 
    81       END IF 
    82  
     81      ENDIF 
     82      ! 
    8383   END SUBROUTINE iscpl_init 
    8484 
     85   !!====================================================================== 
    8586END MODULE iscplini 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r7646 r8568  
    1111   !!   iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet 
    1212   !!---------------------------------------------------------------------- 
     13   USE oce             ! global tra/dyn variable 
    1314   USE dom_oce         ! ocean space and time domain 
    1415   USE domwri          ! ocean space and time domain 
    15    USE domvvl, ONLY : dom_vvl_interpol 
     16   USE domvvl   , ONLY : dom_vvl_interpol 
    1617   USE phycst          ! physical constants 
    1718   USE sbc_oce         ! surface boundary condition variables 
    18    USE oce             ! global tra/dyn variable 
     19   USE iscplini        ! ice sheet coupling: initialisation 
     20   USE iscplhsb        ! ice sheet coupling: conservation 
     21   ! 
    1922   USE in_out_manager  ! I/O manager 
    2023   USE iom             ! I/O module 
    2124   USE lib_mpp         ! MPP library 
    2225   USE lib_fortran     ! MPP library 
    23    USE wrk_nemo        ! Memory allocation 
    2426   USE lbclnk          ! communication 
    25    USE iscplini        ! ice sheet coupling: initialisation 
    26    USE iscplhsb        ! ice sheet coupling: conservation 
    2727 
    2828   IMPLICIT NONE 
    … …  
    5050      !!---------------------------------------------------------------------- 
    5151      INTEGER  ::   inum0 
    52       REAL(wp), DIMENSION(:,:  ), POINTER ::   zsmask_b 
    53       REAL(wp), DIMENSION(:,:,:), POINTER ::   ztmask_b, zumask_b, zvmask_b 
    54       REAL(wp), DIMENSION(:,:,:), POINTER ::   ze3t_b  , ze3u_b  , ze3v_b   
    55       REAL(wp), DIMENSION(:,:,:), POINTER ::   zdepw_b 
     52      REAL(wp), DIMENSION(jpi,jpj)    ::   zsmask_b 
     53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ztmask_b, zumask_b, zvmask_b 
     54      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t_b  , ze3u_b  , ze3v_b   
     55      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zdepw_b 
    5656      CHARACTER(20) :: cfile 
    5757      !!---------------------------------------------------------------------- 
    58  
    59       CALL wrk_alloc(jpi,jpj,jpk,   ztmask_b, zumask_b, zvmask_b) ! mask before 
    60       CALL wrk_alloc(jpi,jpj,jpk,   ze3t_b  , ze3u_b  , ze3v_b  ) ! e3   before 
    61       CALL wrk_alloc(jpi,jpj,jpk,   zdepw_b ) 
    62       CALL wrk_alloc(jpi,jpj,       zsmask_b                    ) 
    63  
    64  
    65       !! get restart variable 
     58      ! 
     59      !                       ! get restart variable 
    6660      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S 
    6761      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity 
    … …  
    7266      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity 
    7367      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 
    74  
    75       !! read namelist 
    76       CALL iscpl_init() 
    77  
    78       !!  ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 
     68      ! 
     69      CALL iscpl_init()       ! read namelist 
     70      !                       ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 
    7971      CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b ) 
    80  
    81       !! compute correction if conservation needed 
    82       IF ( ln_hsb ) THEN 
     72      ! 
     73      IF ( ln_hsb ) THEN      ! compute correction if conservation needed 
    8374         IF( iscpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' ) 
    8475         CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl) 
    8576      END IF 
    8677          
    87       !! print mesh/mask 
    88       IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri      ! Create a domain file 
    89  
     78      !                       ! create  a domain file 
     79      IF( nn_msh /= 0 .AND. ln_iscpl )   CALL dom_wri 
     80      ! 
    9081      IF ( ln_hsb ) THEN 
    9182         cfile='correction' 
    … …  
    9788         CALL iom_close ( inum0 ) 
    9889      END IF 
    99  
    100       CALL wrk_dealloc(jpi,jpj,jpk,   ztmask_b,zumask_b,zvmask_b )   
    101       CALL wrk_dealloc(jpi,jpj,jpk,   ze3t_b  ,ze3u_b  ,ze3v_b   )   
    102       CALL wrk_dealloc(jpi,jpj,jpk,   zdepw_b                    ) 
    103       CALL wrk_dealloc(jpi,jpj,       zsmask_b                   ) 
    104  
    105       !! next step is an euler time step 
    106       neuler = 0 
    107  
    108       !! set _b and _n variables equal 
     90      ! 
     91      neuler = 0              ! next step is an euler time step 
     92      ! 
     93      !                       ! set _b and _n variables equal 
    10994      tsb (:,:,:,:) = tsn (:,:,:,:) 
    11095      ub  (:,:,:)   = un  (:,:,:) 
    11196      vb  (:,:,:)   = vn  (:,:,:) 
    11297      sshb(:,:)     = sshn(:,:) 
    113  
    114       !! set _b and _n vertical scale factor equal 
     98      ! 
     99      !                       ! set _b and _n vertical scale factor equal 
    115100      e3t_b (:,:,:) = e3t_n (:,:,:) 
    116101      e3u_b (:,:,:) = e3u_n (:,:,:) 
    117102      e3v_b (:,:,:) = e3v_n (:,:,:) 
    118  
     103      ! 
    119104      e3uw_b (:,:,:) = e3uw_n (:,:,:) 
    120105      e3vw_b (:,:,:) = e3vw_n (:,:,:) 
    … …  
    150135      REAL(wp):: zdz, zdzm1, zdzp1 
    151136      !! 
    152       REAL(wp), DIMENSION(:,:    ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t 
    153       REAL(wp), DIMENSION(:,:    ), POINTER :: zbub   , zbvb   , zbun  , zbvn 
    154       REAL(wp), DIMENSION(:,:    ), POINTER :: zssh0  , zssh1, zhu1, zhv1 
    155       REAL(wp), DIMENSION(:,:    ), POINTER :: zsmask0, zsmask1 
    156       REAL(wp), DIMENSION(:,:,:  ), POINTER :: ztmask0, ztmask1, ztrp 
    157       REAL(wp), DIMENSION(:,:,:  ), POINTER :: zwmaskn, zwmaskb, ztmp3d 
    158       REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 
     137      REAL(wp), DIMENSION(jpi,jpj)          :: zdmask , zsmask0, zucorr, zbub, zbun, zssh0, zhu1, zde3t 
     138      REAL(wp), DIMENSION(jpi,jpj)          :: zdsmask, zsmask1, zvcorr, zbvb, zbvn, zssh1, zhv1 
     139      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask0, zwmaskn, ztrp 
     140      REAL(wp), DIMENSION(jpi,jpj,jpk)      :: ztmask1, zwmaskb, ztmp3d 
     141      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0 
    159142      !!---------------------------------------------------------------------- 
    160  
    161       !! allocate variables 
    162       CALL wrk_alloc(jpi,jpj,jpk,2, zts0                                   ) 
    163       CALL wrk_alloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp, ztmp3d        )  
    164       CALL wrk_alloc(jpi,jpj,jpk,   zwmaskn, zwmaskb                       )  
    165       CALL wrk_alloc(jpi,jpj,       zsmask0, zsmask1                       )  
    166       CALL wrk_alloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    167       CALL wrk_alloc(jpi,jpj,       zbub   , zbvb    , zbun , zbvn         )  
    168       CALL wrk_alloc(jpi,jpj,       zssh0  , zssh1, zhu1, zhv1             )  
    169  
    170       !! mask value to be sure 
     143      ! 
     144      !                 ! mask value to be sure 
    171145      tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:) 
    172146      tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:) 
    173        
    174       ! compute wmask 
     147      ! 
     148      !                 ! compute wmask 
    175149      zwmaskn(:,:,1) = tmask   (:,:,1) 
    176150      zwmaskb(:,:,1) = ptmask_b(:,:,1) 
    … …  
    179153         zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1) 
    180154      END DO 
    181             
    182       ! compute new ssh if we open a full water column (average of the closest neigbourgs)   
     155      !     
     156      !                 ! compute new ssh if we open a full water column (average of the closest neigbourgs)   
    183157      sshb (:,:)=sshn(:,:) 
    184158      zssh0(:,:)=sshn(:,:) 
    185159      zsmask0(:,:) = psmask_b(:,:) 
    186160      zsmask1(:,:) = psmask_b(:,:) 
    187       DO iz = 1,10    ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
     161      DO iz = 1, 10                 ! need to be tuned (configuration dependent) (OK for ISOMIP+) 
    188162         zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 
    189163         DO jj = 2,jpj-1 
    … …  
    198172                  &           + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk 
    199173                  zsmask1(ji,jj)=1._wp 
    200                END IF 
     174               ENDIF 
    201175            END DO 
    202176         END DO 
    203          CALL lbc_lnk(sshn,'T',1._wp) 
    204          CALL lbc_lnk(zsmask1,'T',1._wp) 
     177         CALL lbc_lnk( sshn   , 'T', 1._wp ) 
     178         CALL lbc_lnk( zsmask1, 'T', 1._wp ) 
    205179         zssh0   = sshn 
    206180         zsmask0 = zsmask1 
    … …  
    210184!============================================================================= 
    211185!PM: Is this needed since introduction of VVL by default? 
    212       IF (.NOT.ln_linssh) THEN 
     186      IF ( .NOT.ln_linssh ) THEN 
    213187      ! Reconstruction of all vertical scale factors at now time steps 
    214188      ! ============================================================================= 
    … …  
    224198            END DO 
    225199         END DO 
    226  
     200         ! 
    227201         CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 
    228202         CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 
    229203         CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 
    230204 
    231       ! Vertical scale factor interpolations 
    232       ! ------------------------------------ 
     205         ! Vertical scale factor interpolations 
     206         ! ------------------------------------ 
    233207         CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W'  ) 
    234208         CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    235209         CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
    236  
    237       ! t- and w- points depth 
    238       ! ---------------------- 
     210          
     211         ! t- and w- points depth 
     212         ! ---------------------- 
    239213         gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 
    240214         gdepw_n(:,:,1) = 0.0_wp 
    … …  
    429403      ! nothing to do 
    430404      !  
    431       ! deallocation tmp arrays 
    432       CALL wrk_dealloc(jpi,jpj,jpk,2, zts0                                   ) 
    433       CALL wrk_dealloc(jpi,jpj,jpk,   ztmask0, ztmask1 , ztrp                )  
    434       CALL wrk_dealloc(jpi,jpj,jpk,   zwmaskn, zwmaskb , ztmp3d              )  
    435       CALL wrk_dealloc(jpi,jpj,       zsmask0, zsmask1                       )  
    436       CALL wrk_dealloc(jpi,jpj,       zdmask , zdsmask, zvcorr, zucorr, zde3t)  
    437       CALL wrk_dealloc(jpi,jpj,       zbub   , zbvb    , zbun  , zbvn        )  
    438       CALL wrk_dealloc(jpi,jpj,       zssh0  , zssh1  , zhu1 , zhv1          )  
    439       ! 
    440405   END SUBROUTINE iscpl_rst_interpol 
    441406 

  • branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r7753 r8568  
    3636   USE lib_mpp         ! MPP library 
    3737   USE restart         ! restart 
    38    USE wrk_nemo        ! Memory allocation 
    3938   USE timing          ! Timing 
    4039 
    … …  
    6059      !!---------------------------------------------------------------------- 
    6160      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    62       REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     61!!gm see comment further down 
     62      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   zuvd    ! U & V data workspace 
     63!!gm end 
    6364      !!---------------------------------------------------------------------- 
    6465      ! 
    65       IF( nn_timing == 1 )   CALL timing_start('istate_init') 
     66      IF( ln_timing )   CALL timing_start('istate_init') 
    6667      ! 
    6768      IF(lwp) WRITE(numout,*) 
    … …  
    121122!!gm to be moved in usrdef of C1D case 
    122123!         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
    123 !            CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
     124!            ALLOCATE( zuvd(jpi,jpj,jpk,2) ) 
    124125!            CALL dta_uvd( nit000, zuvd ) 
    125126!            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    126127!            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
    127 !            CALL wrk_dealloc( jpi,jpj,jpk,2,  zuvd ) 
     128!            DEALLOCATE( zuvd ) 
    128129!         ENDIF 
    129130         ! 
    … …  
    164165      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
    165166      ! 
    166       IF( nn_timing == 1 )   CALL timing_stop('istate_init') 
     167      IF( ln_timing )   CALL timing_stop('istate_init') 
    167168      ! 
    168169   END SUBROUTINE istate_init 
Note: See TracChangeset for help on using the changeset viewer.