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

Changeset 2444


Ignore:
Timestamp:
2010-11-29T15:30:48+01:00 (13 years ago)
Author:
cetlod
Message:

Improvment of OFFLINE in v3.3beta (review done by gm) : clean the style in all routines, suppression of key_zdfddm

Location:
branches/nemo_v3_3_beta/NEMOGCM
Files:
1 deleted
7 edited

Legend:

Unmodified
Added
Removed

  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/cpp_ORCA2_OFF_PISCES.fcm

    r2340 r2444  
    1 bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_dynspg_flt key_ldfslp key_traldf_c2d key_traldf_eiv key_zdftke key_zdfddm key_top key_offline key_pisces key_dtatrc key_diatrc key_iomput key_nproci=1 key_nprocj=1 
     1bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_dynspg_flt key_ldfslp key_traldf_c2d key_traldf_eiv key_zdftke key_top key_offline key_pisces key_dtatrc key_diatrc key_iomput key_nproci=1 key_nprocj=1 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/dommsk.F90

    r2287 r2444  
    11MODULE dommsk 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE dommsk   *** 
    4    !! Ocean initialization : domain land/sea mask  
    5    !!============================================================================== 
     4   !! Ocean initialization : domain land/sea masks, off-line case  
     5   !!====================================================================== 
     6   !! History :  3.3  ! 2010-10  (C. Ethe)  adapted from OPA_SRC/DOM/dommsk 
     7   !!---------------------------------------------------------------------- 
    68 
    79   !!---------------------------------------------------------------------- 
    810   !!   dom_msk        : compute land/ocean mask 
    911   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1112   USE oce             ! ocean dynamics and tracers 
    1213   USE dom_oce         ! ocean space and time domain 
    1314   USE in_out_manager  ! I/O manager 
    14    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    15    USE lib_mpp 
    1615 
    1716   IMPLICIT NONE 
    1817   PRIVATE 
    1918 
    20    !! * Routine accessibility 
    21    PUBLIC dom_msk        ! routine called by inidom.F90 
     19   PUBLIC   dom_msk    ! routine called by inidom.F90 
    2220 
    23    !! * Module variables 
    2421#if defined key_degrad 
    2522   !! ------------------------------------------------ 
    2623   !! Degradation method 
    2724   !! -------------------------------------------------- 
    28    REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: & 
    29       facvol  !! volume for degraded regions 
     25   REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) ::   facvol  !! volume for degraded regions 
    3026#endif 
     27 
    3128   !! * Substitutions 
    3229#  include "vectopt_loop_substitute.h90" 
    … …  
    3431   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    3532   !! $Id$ 
    36    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3734   !!---------------------------------------------------------------------- 
    38  
    3935CONTAINS 
    4036    
    … …  
    4339      !!                 ***  ROUTINE dom_msk  *** 
    4440      !! 
    45       !! ** Purpose :   Compute land/ocean mask arrays at tracer points, hori- 
    46       !!      zontal velocity points (u & v), vorticity points (f) and baro- 
    47       !!      tropic stream function  points (b). 
    48       !!        Set mbathy to the number of non-zero w-levels of a water column 
    49       !!      (if island in the domain (lk_isl=T), this is done latter in 
    50       !!      routine solver_init) 
     41      !! ** Purpose :   Off-line case: defines the interior domain T-mask. 
    5142      !! 
    52       !! ** Method  :   The ocean/land mask is computed from the basin bathy- 
    53       !!      metry in level (mbathy) which is defined or read in dommba. 
    54       !!      mbathy equals 0 over continental T-point, -n over the nth  
    55       !!      island T-point, and the number of ocean level over the ocean. 
     43      !! ** Method  :   The interior ocean/land mask is computed from tmask 
     44      !!              setting to zero the duplicated row and lines due to 
     45      !!              MPP exchange halos, est-west cyclic and north fold 
     46      !!              boundary conditions. 
    5647      !! 
    57       !!      At a given position (ji,jj,jk) the ocean/land mask is given by: 
    58       !!      t-point : 0. IF mbathy( ji ,jj) =< 0 
    59       !!                1. IF mbathy( ji ,jj) >= jk 
    60       !!      u-point : 0. IF mbathy( ji ,jj)  or mbathy(ji+1, jj ) =< 0 
    61       !!                1. IF mbathy( ji ,jj) and mbathy(ji+1, jj ) >= jk. 
    62       !!      v-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) =< 0 
    63       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) >= jk. 
    64       !!      f-point : 0. IF mbathy( ji ,jj)  or mbathy( ji ,jj+1) 
    65       !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0 
    66       !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 
    67       !!                and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 
    68       !!      b-point : the same definition as for f-point of the first ocean 
    69       !!                level (surface level) but with 0 along coastlines. 
    70       !! 
    71       !!        The lateral friction is set through the value of fmask along 
    72       !!      the coast and topography. This value is defined by shlat, a 
    73       !!      namelist parameter: 
    74       !!         shlat = 0, free slip  (no shear along the coast) 
    75       !!         shlat = 2, no slip  (specified zero velocity at the coast) 
    76       !!         0 < shlat < 2, partial slip   | non-linear velocity profile 
    77       !!         2 < shlat, strong slip        | in the lateral boundary layer 
    78       !! 
    79       !!      N.B. If nperio not equal to 0, the land/ocean mask arrays 
    80       !!      are defined with the proper value at lateral domain boundaries, 
    81       !!      but bmask. indeed, bmask defined the domain over which the 
    82       !!      barotropic stream function is computed. this domain cannot 
    83       !!      contain identical columns because the matrix associated with 
    84       !!      the barotropic stream function equation is then no more inverti- 
    85       !!      ble. therefore bmask is set to 0 along lateral domain boundaries 
    86       !!      even IF nperio is not zero. 
    87       !! 
    88       !!      In case of open boundaries (lk_obc=T): 
    89       !!        - tmask is set to 1 on the points to be computed bay the open 
    90       !!          boundaries routines. 
    91       !!        - bmask is  set to 0 on the open boundaries. 
    92       !! 
    93       !!      Set mbathy to the number of non-zero w-levels of a water column 
    94       !!                  mbathy = min( mbathy, 1 ) + 1 
    95       !!      (note that the minimum value of mbathy is 2). 
    96       !! 
    97       !! ** Action : 
    98       !!                     tmask    : land/ocean mask at t-point (=0. or 1.) 
    99       !!                     umask    : land/ocean mask at u-point (=0. or 1.) 
    100       !!                     vmask    : land/ocean mask at v-point (=0. or 1.) 
    101       !!                     fmask    : land/ocean mask at f-point (=0. or 1.) 
    102       !!                          =shlat along lateral boundaries 
    103       !!                     bmask    : land/ocean mask at barotropic stream 
    104       !!                          function point (=0. or 1.) and set to 
    105       !!                          0 along lateral boundaries 
    106       !!                   mbathy   : number of non-zero w-levels  
    107       !! 
    108       !! History : 
    109       !!        !  87-07  (G. Madec)  Original code 
    110       !!        !  91-12  (G. Madec) 
    111       !!        !  92-06  (M. Imbard) 
    112       !!        !  93-03  (M. Guyon)  symetrical conditions (M. Guyon) 
    113       !!        !  96-01  (G. Madec)  suppression of common work arrays 
    114       !!        !  96-05  (G. Madec)  mask computed from tmask and sup- 
    115       !!                 pression of the double computation of bmask 
    116       !!        !  97-02  (G. Madec)  mesh information put in domhgr.F 
    117       !!        !  97-07  (G. Madec)  modification of mbathy and fmask 
    118       !!        !  98-05  (G. Roullet)  free surface 
    119       !!        !  00-03  (G. Madec)  no slip accurate 
    120       !!        !  01-09  (J.-M. Molines)  Open boundaries 
    121       !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
     48      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point 
     49      !!               tpol     : ??? 
    12250      !!---------------------------------------------------------------------- 
    123       !! *Local declarations 
    124       INTEGER  ::   ji, jk     ! dummy loop indices 
    125       INTEGER  ::   iif, iil, ijf, ijl 
    126       INTEGER, DIMENSION(jpi,jpj) ::  imsk 
    127  
     51      INTEGER  ::   ji, jk                   ! dummy loop indices 
     52      INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
     53      INTEGER, DIMENSION(jpi,jpj) ::  imsk   ! 2D workspace 
    12854      !!--------------------------------------------------------------------- 
    129        
    130  
    131  
     55      ! 
    13256      ! Interior domain mask (used for global sum) 
    13357      ! -------------------- 
    134  
    13558      tmask_i(:,:) = tmask(:,:,1) 
    136       iif = jpreci                         ! ??? 
     59      iif = jpreci                        ! thickness of exchange halos in i-axis 
    13760      iil = nlci - jpreci + 1 
    138       ijf = jprecj                         ! ??? 
     61      ijf = jprecj                        ! thickness of exchange halos in j-axis 
    13962      ijl = nlcj - jprecj + 1 
    140  
    141       tmask_i( 1 :iif,   :   ) = 0.e0      ! first columns 
    142       tmask_i(iil:jpi,   :   ) = 0.e0      ! last  columns (including mpp extra columns) 
    143       tmask_i(   :   , 1 :ijf) = 0.e0      ! first rows 
    144       tmask_i(   :   ,ijl:jpj) = 0.e0      ! last  rows (including mpp extra rows) 
    145  
    146  
    147       ! north fold mask 
    148       tpol(1:jpiglo) = 1.e0  
    149       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    150          tpol(jpiglo/2+1:jpiglo) = 0.e0 
    151       ENDIF 
    152       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    153          tpol(     1    :jpiglo) = 0.e0 
    154       ENDIF 
    155  
     63      ! 
     64      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns 
     65      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns) 
     66      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows 
     67      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows) 
     68      ! 
     69      !                                   ! north fold mask 
     70      tpol(1:jpiglo) = 1._wp 
     71      !                                 
     72      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot 
     73      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot 
    15674      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row 
    157          if (mjg(ijl-1) == jpjglo-1) then 
    158          DO ji = iif+1, iil-1 
    159             tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 
    160          END DO 
    161          endif 
     75         IF( mjg(ijl-1) == jpjglo-1 ) THEN 
     76            DO ji = iif+1, iil-1 
     77               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 
     78            END DO 
     79         ENDIF 
    16280      ENDIF  
    163  
    164       ! Control print 
    165       ! ------------- 
    166       IF( nprint == 1 .AND. lwp ) THEN 
     81      ! 
     82      IF( nprint == 1 .AND. lwp ) THEN    ! Control print 
    16783         imsk(:,:) = INT( tmask_i(:,:) ) 
    16884         WRITE(numout,*) ' tmask_i : ' 
    169          CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    170                &                           1, jpj, 1, 1, numout) 
     85         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
    17186         WRITE (numout,*) 
    17287         WRITE (numout,*) ' dommsk: tmask for each level' 
    … …  
    17489         DO jk = 1, jpk 
    17590            imsk(:,:) = INT( tmask(:,:,jk) ) 
    176  
    17791            WRITE(numout,*) 
    17892            WRITE(numout,*) ' level = ',jk 
    179             CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    180                &                              1, jpj, 1, 1, numout) 
     93            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
    18194         END DO 
    18295      ENDIF 
    183  
     96      ! 
    18497   END SUBROUTINE dom_msk 
    18598 
     99   !!====================================================================== 
    186100END MODULE dommsk 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/domrea.F90

    r2431 r2444  
    1111   !!                         = 3  :   mesh_hgr, mesh_zgr and mask 
    1212   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1413   USE dom_oce         ! ocean space and time domain 
    15    USE dommsk   
    16    USE in_out_manager 
     14   USE dommsk          ! domain: masks 
     15   USE in_out_manager  ! I/O manager 
    1716 
    1817   IMPLICIT NONE 
    1918   PRIVATE 
    2019 
    21    !! * Accessibility 
    22    PUBLIC dom_rea        ! routine called by inidom.F90 
     20   PUBLIC   dom_rea    ! routine called by inidom.F90 
    2321   !!---------------------------------------------------------------------- 
    2422   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    … …  
    2927CONTAINS 
    3028 
    31 #if ( defined key_mpp_mpi || defined key_mpp_shmem ) && defined key_dimgout 
     29#if   defined key_mpp_mpi   &&  defined key_dimgout 
    3230   !!---------------------------------------------------------------------- 
    3331   !!   'key_mpp_mpi'     OR 
    34    !!   'key_mpp_shmem' 
    3532   !!   'key_dimgout' :         each processor makes its own direct access file  
    3633   !!                      use build_nc_meshmask off line to retrieve  
    … …  
    3835   !!---------------------------------------------------------------------- 
    3936#  include "domrea_dimg.h90" 
    40  
    4137 
    4238#else 
    … …  
    6763      !!      meshmask.nc  : domain size, horizontal grid-point position, 
    6864      !!                     masks, depth and vertical scale factors 
     65      !!---------------------------------------------------------------------- 
     66      USE iom 
    6967      !! 
    70       !! History : 
    71       !!        !  97-02  (G. Madec)  Original code 
    72       !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL 
    73       !!   9.0  !  02-08  (G. Madec)  F90 and several file 
    74       !!        !  06-07  (C. Ethe )  Use of iom module 
     68      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     69      INTEGER  ::   ik, inum0 , inum1 , inum2 , inum3 , inum4   ! local integers 
     70      REAL(wp) ::   zrefdep         ! local real 
     71      REAL(wp), DIMENSION(jpi,jpj) ::   zprt   ! 2D workspace 
    7572      !!---------------------------------------------------------------------- 
    76       !! * Modules used 
    77       USE iom 
    78  
    79       !! * Local declarations 
    80       INTEGER  ::   ji, jj, jk 
    81       INTEGER  ::                & !!! * temprary units for : 
    82          inum0 ,                 &  ! 'mesh_mask.nc' file 
    83          inum1 ,                 &  ! 'mesh.nc'      file 
    84          inum2 ,                 &  ! 'mask.nc'      file 
    85          inum3 ,                 &  ! 'mesh_hgr.nc'  file 
    86          inum4                      ! 'mesh_zgr.nc'  file 
    87   
    88       REAL(wp), DIMENSION(jpi,jpj) :: zprt 
    89       REAL(wp) ::   zrefdep         ! depth of the reference level (~10m) 
    90       INTEGER  :: ik 
    91       !!---------------------------------------------------------------------- 
    92  
    93        IF(lwp) WRITE(numout,*) 
    94        IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)' 
    95        IF(lwp) WRITE(numout,*) '~~~~~~~' 
    96  
    97  
    98       zprt(:,:) = 0. 
     73 
     74      IF(lwp) WRITE(numout,*) 
     75      IF(lwp) WRITE(numout,*) 'dom_rea : read NetCDF mesh and mask information file(s)' 
     76      IF(lwp) WRITE(numout,*) '~~~~~~~' 
     77 
     78      zprt(:,:) = 0._wp 
    9979 
    10080      SELECT CASE (nmsh) 
    … …  
    180160         DO jj = 1, jpj 
    181161            DO ji = 1, jpi 
    182                mbathy(ji,jj) = MAX( zprt(ji,jj) * tmask(ji,jj,1), 1. ) + 1 
     162               mbathy(ji,jj) = MAX( zprt(ji,jj) * tmask(ji,jj,1), 1._wp ) + 1 
    183163            ENDDO 
    184164         ENDDO 
    … …  
    262242!!gm BUG in s-coordinate this does not work! 
    263243      ! deepest/shallowest W level Above/Below ~10m 
    264       zrefdep = 10. - ( 0.1*MINVAL(e3w_0) )                          ! ref. depth with tolerance (10% of minimum layer thickness) 
     244      zrefdep = 10._wp - ( 0.1_wp * MINVAL(e3w_0) )                  ! ref. depth with tolerance (10% of minimum layer thickness) 
    265245      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Below ~10m 
    266246      nla10 = nlb10 - 1                                              ! deepest    W level Above ~10m 
    … …  
    308288 
    309289      DO jk = 1, jpk 
    310          IF( e3w_0(jk) <= 0. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop ( ' e3w_0 or e3t_0 =< 0 ' ) 
    311          IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0.) CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' ) 
     290         IF( e3w_0  (jk) <= 0._wp .OR. e3t_0  (jk) <= 0._wp )   CALL ctl_stop( ' e3w_0 or e3t_0 =< 0 ' ) 
     291         IF( gdepw_0(jk) <  0._wp .OR. gdept_0(jk) <  0._wp )  CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' ) 
    312292      END DO 
    313  
    314          !                                     ! ============================ 
    315          !                                     !        close the files  
    316          !                                     ! ============================ 
    317          SELECT CASE ( nmsh ) 
    318             CASE ( 1 )                 
    319                CALL iom_close( inum0 ) 
    320             CASE ( 2 ) 
    321                CALL iom_close( inum1 ) 
    322                CALL iom_close( inum2 ) 
    323             CASE ( 3 ) 
    324                CALL iom_close( inum2 ) 
    325                CALL iom_close( inum3 ) 
    326                CALL iom_close( inum4 ) 
    327          END SELECT 
    328  
     293      !                                     ! ============================ 
     294      !                                     !        close the files  
     295      !                                     ! ============================ 
     296      SELECT CASE ( nmsh ) 
     297         CASE ( 1 )                 
     298            CALL iom_close( inum0 ) 
     299         CASE ( 2 ) 
     300            CALL iom_close( inum1 ) 
     301            CALL iom_close( inum2 ) 
     302         CASE ( 3 ) 
     303            CALL iom_close( inum2 ) 
     304            CALL iom_close( inum3 ) 
     305            CALL iom_close( inum4 ) 
     306      END SELECT 
     307      ! 
    329308   END SUBROUTINE dom_rea 
    330309 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    r2435 r2444  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  dtadyn  *** 
    4    !! OFFLINE : interpolation of the physical fields 
    5    !!===================================================================== 
     4   !! Off-line : interpolation of the physical fields 
     5   !!====================================================================== 
     6   !! History :   OPA  ! 1992-01 (M. Imbard) Original code 
     7   !!             8.0  ! 1998-04 (L.Bopp MA Foujols) slopes for isopyc.  
     8   !!              -   ! 1998-05 (L. Bopp) read output of coupled run 
     9   !!             8.2  ! 2001-01 (M. Levy et M. Benjelloul) add netcdf FORMAT 
     10   !!   NEMO      1.0  ! 2005-03 (O. Aumont and A. El Moussaoui) F90 
     11   !!              -   ! 2005-12 (C. Ethe) Adapted for DEGINT 
     12   !!             3.0  ! 2007-06 (C. Ethe) use of iom module 
     13   !!              -   ! 2007-09  (C. Ethe)  add swap_dyn_data 
     14   !!             3.3  ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line 
     15   !!---------------------------------------------------------------------- 
    616 
    717   !!---------------------------------------------------------------------- 
    … …  
    919   !!   dta_dyn      : Interpolation of the fields 
    1020   !!---------------------------------------------------------------------- 
    11    !! * Modules used 
    1221   USE oce             ! ocean dynamics and tracers variables 
    13    USE dom_oce         ! ocean space and time domain variables 
    14    USE zdf_oce         ! ocean vertical physics 
    15    USE in_out_manager  ! I/O manager 
     22   USE c1d             ! 1D configuration: lk_c1d 
     23   USE dom_oce         ! ocean domain: variables 
     24   USE zdf_oce         ! ocean vertical physics: variables 
     25   USE sbc_oce         ! surface module: variables 
    1626   USE phycst          ! physical constants 
    17    USE sbc_oce 
    18    USE trabbl 
    19    USE ldfslp 
     27   USE trabbl          ! active tracer: bottom boundary layer 
     28   USE ldfslp          ! lateral diffusion: iso-neutral slopes 
    2029   USE ldfeiv          ! eddy induced velocity coef.  
    2130   USE ldftra_oce      ! ocean tracer   lateral physics 
    22    USE zdfmxl 
    23    USE eosbn2 
    24    USE zdfddm          ! vertical  physics: double diffusion 
     31   USE zdfmxl          ! vertical physics: mixed layer depth 
     32   USE eosbn2          ! equation of state - Brunt Vaisala frequency 
    2533   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    26    USE zpshde 
     34   USE zpshde          ! z-coord. with partial steps: horizontal derivatives 
     35   USE in_out_manager  ! I/O manager 
     36   USE iom             ! I/O library 
    2737   USE lib_mpp         ! distributed memory computing library 
    28    USE c1d 
    2938 
    3039   IMPLICIT NONE 
    3140   PRIVATE 
    3241 
    33    !! *  Routine accessibility 
    34    PUBLIC dta_dyn_init   ! called by opa.F90 
    35    PUBLIC dta_dyn        ! called by step.F90 
    36  
    37    LOGICAL , PUBLIC :: & 
    38       lperdyn = .TRUE. , & ! boolean for periodic fields or not 
    39       lfirdyn = .TRUE.     ! boolean for the first call or not 
    40  
    41    INTEGER , PUBLIC :: & 
    42       ndtadyn = 73 ,  & ! Number of dat in one year 
    43       ndtatot = 73 ,  & ! Number of data in the input field 
    44       nsptint = 1       ! type of spatial interpolation 
    45  
    46    CHARACTER(len=45)  ::  & 
    47       cfile_grid_T = 'dyna_grid_T.nc', &   !: name of the grid_T file 
    48       cfile_grid_U = 'dyna_grid_U.nc', &   !: name of the grid_U file 
    49       cfile_grid_V = 'dyna_grid_V.nc', &   !: name of the grid_V file 
    50       cfile_grid_W = 'dyna_grid_W.nc'      !: name of the grid_W file 
     42   PUBLIC   dta_dyn_init   ! called by opa.F90 
     43   PUBLIC   dta_dyn        ! called by step.F90 
     44 
     45   LOGICAL, PUBLIC ::   lperdyn = .TRUE.   !: boolean for periodic fields or not 
     46   LOGICAL, PUBLIC ::   lfirdyn = .TRUE.   !: boolean for the first call or not 
     47 
     48   INTEGER, PUBLIC ::   ndtadyn = 73       !: Number of dat in one year 
     49   INTEGER, PUBLIC ::   ndtatot = 73       !: Number of data in the input field 
     50   INTEGER, PUBLIC ::   nsptint = 1        !: type of spatial interpolation 
     51 
     52   CHARACTER(len=45) ::   cfile_grid_T = 'dyna_grid_T.nc'   ! name of the grid_T file 
     53   CHARACTER(len=45) ::   cfile_grid_U = 'dyna_grid_U.nc'   ! name of the grid_U file 
     54   CHARACTER(len=45) ::   cfile_grid_V = 'dyna_grid_V.nc'   ! name of the grid_V file 
     55   CHARACTER(len=45) ::   cfile_grid_W = 'dyna_grid_W.nc'   ! name of the grid_W file 
    5156    
    52    REAL(wp)      ::   & 
    53       rnspdta  ,       &  !: number of time step per 2 consecutives data 
    54       rnspdta2            !: rnspdta * 0.5 
    55  
    56    INTEGER ::     & 
    57       ndyn1, ndyn2 , & 
    58       nlecoff = 0  , & ! switch for the first read 
    59       numfl_t, numfl_u, & 
    60       numfl_v, numfl_w 
    61  
    62    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    63       tdta   ,   & ! temperature at two consecutive times 
    64       sdta   ,   & ! salinity at two consecutive times 
    65       udta   ,   & ! zonal velocity at two consecutive times 
    66       vdta   ,   & ! meridional velocity at two consecutive times 
    67       wdta   ,   & ! vertical velocity at two consecutive times 
    68       avtdta       ! vertical diffusivity coefficient 
    69  
    70    REAL(wp), DIMENSION(jpi,jpj,2) ::       & 
    71       hmlddta,   & ! mixed layer depth at two consecutive times 
    72       wspddta,   & ! wind speed at two consecutive times 
    73       frlddta,   & ! sea-ice fraction at two consecutive times 
    74       empdta ,   & ! E-P at two consecutive times 
    75       qsrdta       ! short wave heat flux at two consecutive times 
    76  
     57   REAL(wp) ::   rnspdta    ! number of time step per 2 consecutives data 
     58   REAL(wp) ::   rnspdta2   ! rnspdta * 0.5 
     59 
     60   INTEGER ::   ndyn1, ndyn2    ! 
     61   INTEGER ::   nlecoff = 0     ! switch for the first read 
     62   INTEGER ::   numfl_t, numfl_u, numfl_v, numfl_w 
     63 
     64   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   tdta       ! temperature at two consecutive times 
     65   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   sdta       ! salinity at two consecutive times 
     66   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   udta       ! zonal velocity at two consecutive times 
     67   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   vdta       ! meridional velocity at two consecutive times 
     68   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   wdta       ! vertical velocity at two consecutive times 
     69   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   avtdta     ! vertical diffusivity coefficient 
     70 
     71   REAL(wp), DIMENSION(jpi,jpj    ,2) ::   hmlddta    ! mixed layer depth at two consecutive times 
     72   REAL(wp), DIMENSION(jpi,jpj    ,2) ::   wspddta    ! wind speed at two consecutive times 
     73   REAL(wp), DIMENSION(jpi,jpj    ,2) ::   frlddta    ! sea-ice fraction at two consecutive times 
     74   REAL(wp), DIMENSION(jpi,jpj    ,2) ::   empdta     ! E-P at two consecutive times 
     75   REAL(wp), DIMENSION(jpi,jpj    ,2) ::   qsrdta     ! short wave heat flux at two consecutive times 
    7776#if defined key_ldfslp 
    78    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    79       uslpdta ,  & ! zonal isopycnal slopes 
    80       vslpdta ,  & ! meridional isopycnal slopes 
    81       wslpidta , & ! zonal diapycnal slopes 
    82       wslpjdta     ! meridional diapycnal slopes 
    83 #endif 
    84  
     77   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   uslpdta    ! zonal isopycnal slopes 
     78   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   vslpdta    ! meridional isopycnal slopes 
     79   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   wslpidta   ! zonal diapycnal slopes 
     80   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   wslpjdta   ! meridional diapycnal slopes 
     81#endif 
    8582#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv  
    86    REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    87       aeiwdta      ! G&M coefficient 
    88 #endif 
    89  
     83   REAL(wp), DIMENSION(jpi,jpj    ,2) ::   aeiwdta    ! G&M coefficient 
     84#endif 
    9085#if defined key_degrad 
    91    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    92       ahtudta, ahtvdta, ahtwdta  !  Lateral diffusivity 
     86   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   ahtudta, ahtvdta, ahtwdta   ! Lateral diffusivity 
    9387# if defined key_traldf_eiv 
    94    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    95       aeiudta, aeivdta, aeiwdta  ! G&M coefficient 
     88   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   aeiudta, aeivdta, aeiwdta   ! G&M coefficient 
    9689# endif 
    97  
    9890#endif 
    9991 
    … …  
    10496   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    10597   !! $Id$ 
    106    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     98   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    10799   !!---------------------------------------------------------------------- 
    108  
    109100CONTAINS 
    110101 
    … …  
    113104      !!                  ***  ROUTINE dta_dyn  *** 
    114105      !! 
    115       !! ** Purpose : Prepares dynamics and physics fields from an  
    116       !!              OPA9 simulation  for an off-line simulation 
    117       !!               for passive tracer 
     106      !! ** Purpose :   Prepares dynamics and physics fields from an NEMO run 
     107      !!              for an off-line simulation of passive tracers 
    118108      !! 
    119109      !! ** Method : calculates the position of DATA to read READ DATA  
    120110      !!             (example month changement) computes slopes IF needed 
    121111      !!             interpolates DATA IF needed 
    122       !! 
    123       !! ** History : 
    124       !!   ! original  : 92-01 (M. Imbard: sub domain) 
    125       !!   ! addition  : 98-04 (L.Bopp MA Foujols: slopes for isopyc.)  
    126       !!   ! addition  : 98-05 (L. Bopp read output of coupled run) 
    127       !!   ! addition  : 05-03 (O. Aumont and A. El Moussaoui) F90 
    128       !!   ! addition  : 05-12 (C. Ethe) Adapted for DEGINT 
    129       !!---------------------------------------------------------------------- 
    130       !! * Arguments 
    131       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    132  
    133       !! * Local declarations 
    134       INTEGER ::   iper, iperm1, iswap, izt    
    135  
    136       REAL(wp) :: zt 
    137       REAL(wp) :: zweigh 
    138       !!---------------------------------------------------------------------- 
    139  
    140       zt       = ( FLOAT (kt) + rnspdta2 ) / rnspdta 
    141       izt      = INT( zt ) 
    142       zweigh   = zt - FLOAT( INT(zt) ) 
    143  
    144       IF( lperdyn ) THEN 
    145          iperm1 = MOD( izt, ndtadyn ) 
    146       ELSE 
    147          iperm1 = MOD( izt, ndtatot - 1 ) + 1 
     112      !!---------------------------------------------------------------------- 
     113      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     114      !! 
     115      INTEGER  ::   iper, iperm1, iswap, izt   ! local integers  
     116      REAL(wp) ::   zt, zweigh                 ! local scalars 
     117      !!---------------------------------------------------------------------- 
     118 
     119      zt     = ( REAL(kt,wp) + rnspdta2 ) / rnspdta 
     120      izt    = INT( zt ) 
     121      zweigh = zt - REAL( INT(zt), wp ) 
     122 
     123      IF( lperdyn ) THEN   ;   iperm1 = MOD( izt, ndtadyn ) 
     124      ELSE                 ;   iperm1 = MOD( izt, ndtatot - 1 ) + 1 
    148125      ENDIF 
    149126 
    … …  
    154131          ELSE  
    155132              IF( lfirdyn ) THEN  
    156                   IF (lwp) WRITE (numout,*) &  
    157                       &   ' dynamic file is not periodic with or without interpolation  & 
    158                       &   we take the first value for the previous period iperm1 = 0  ' 
     133                  IF(lwp) WRITE (numout,*) 'dta_dyn:  dynamic file is not periodic with or without interpolation    & 
     134                     &                                we take the first value for the previous period iperm1 = 0  ' 
    159135              END IF 
    160136          END IF  
    … …  
    167143 
    168144      IF( lfirdyn ) THEN 
    169          ! store the information of the period read 
    170          ndyn1 = iperm1 
     145         ndyn1 = iperm1         ! store the information of the period read 
    171146         ndyn2 = iper 
    172147          
    173          IF (lwp) THEN 
    174             WRITE (numout,*) ' dynamics data read for the period ndyn1 =',ndyn1, & 
    175                &             ' and for the period ndyn2 = ',ndyn2 
     148         IF(lwp) THEN 
     149            WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,  & 
     150               &             ' and for the period ndyn2 = ', ndyn2 
    176151            WRITE (numout,*) ' time step is : ', kt 
    177             WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,' records in the dynamic file for one year' 
     152            WRITE (numout,*) ' we have ndtadyn = ', ndtadyn, ' records in the dynamic file for one year' 
    178153         END IF 
    179154         ! 
    180          IF( iperm1 /= 0 ) THEN         ! data read for the iperm1 period 
    181             CALL dynrea( kt, iperm1 )  
    182          ELSE  
    183             CALL dynrea( kt, 1 ) 
    184          ENDIF 
     155!!gm simplier:                        CALL dynrea( kt, MAX( 1, iperm1) ) 
     156           CALL dynrea( kt, MAX( 1, iperm1) ) 
     157!!         IF( iperm1 /= 0 ) THEN   ;   CALL dynrea( kt, iperm1 )      ! data read for the iperm1 period 
     158!!         ELSE                     ;   CALL dynrea( kt, 1      ) 
     159!!         ENDIF 
    185160          
    186          IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 
    187             ! Computes slopes. Caution : here tsn and avt are used as workspace 
     161         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN      ! Computes slopes (here tsn and avt are used as workspace) 
    188162            tsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
    189163            tsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
    … …  
    195169               &   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
    196170               &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level 
    197                    CALL zdf_mxl( kt )              ! mixed layer depth 
    198                    CALL ldf_slp( kt, rhd, rn2 ) 
     171            CALL zdf_mxl( kt )           ! mixed layer depth 
     172            CALL ldf_slp( kt, rhd, rn2 ) 
    199173          
    200174            uslpdta (:,:,:,2) = uslp (:,:,:) 
    … …  
    203177            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    204178         END IF 
    205           
    206          ! swap from record 2 to 1 
    207          CALL swap_dyn_data 
    208           
     179         ! 
     180         CALL swap_dyn_data            ! swap from record 2 to 1 
     181         ! 
    209182         iswap = 1        !  indicates swap 
    210           
    211          CALL dynrea( kt, iper )    ! data read for the iper period 
    212           
    213          IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 
    214             ! Computes slopes. Caution : here tsn and avt are used as workspace 
     183         ! 
     184         CALL dynrea( kt, iper )       ! data read for the iper period 
     185         ! 
     186         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN      ! Computes slopes (here tsn and avt are used as workspace) 
    215187            tsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
    216188            tsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
    217189            avt(:,:,:)         = avtdta(:,:,:,2) 
    218           
    219             CALL eos( tsn, rhd, rhop )   ! Time-filtered in situ density  
    220             CALL bn2( tsn, rn2 )         ! before Brunt-Vaisala frequency 
    221             IF( ln_zps )   & 
    222                &   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
    223                &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level 
    224                    CALL zdf_mxl( kt )              ! mixed layer depth 
    225                    CALL ldf_slp( kt, rhd, rn2 ) 
    226  
     190            ! 
     191                           CALL eos( tsn, rhd, rhop )                   ! now in situ density  
     192                           CALL bn2( tsn, rn2 )                         ! now Brunt-Vaisala frequency 
     193            IF( ln_zps )   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
     194               &                                   rhd, gru , grv   )   ! of t, s, rd at the bottom ocean level 
     195                           CALL zdf_mxl( kt )                           ! mixed layer depth 
     196                           CALL ldf_slp( kt, rhd, rn2 )                 ! slope of iso-neutral surfaces 
     197            ! 
    227198            uslpdta (:,:,:,2) = uslp (:,:,:) 
    228199            vslpdta (:,:,:,2) = vslp (:,:,:) 
    … …  
    231202         END IF 
    232203         ! 
    233          lfirdyn=.FALSE.    ! trace the first call 
     204         lfirdyn = .FALSE.    ! trace the first call 
    234205      ENDIF 
    235206      ! 
    … …  
    238209      ! 
    239210      IF( iperm1 /= ndyn1 ) THEN  
    240  
    241          IF( iperm1 == 0. ) THEN 
    242             IF (lwp) THEN 
     211         ! 
     212         IF( iperm1 == 0 ) THEN 
     213            IF(lwp) THEN 
    243214               WRITE (numout,*) ' dynamic file is not periodic with periodic interpolation' 
    244215               WRITE (numout,*) ' we take the last value for the last period ' 
    … …  
    249220         ENDIF 
    250221         ! 
    251          ! We have to prepare a new read of data : swap from record 2 to 1 
    252          ! 
    253          CALL swap_dyn_data 
    254  
    255          iswap = 1        !  indicates swap 
    256           
     222         CALL swap_dyn_data         ! We have to prepare a new read of data : swap from record 2 to 1 
     223         ! 
     224         iswap = 1                  !  indicates swap 
     225         ! 
    257226         CALL dynrea( kt, iper )    ! data read for the iper period 
    258  
     227         ! 
    259228         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 
    260229            ! Computes slopes. Caution : here tsn and avt are used as workspace 
    261             tsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
    262             tsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
    263             avt(:,:,:)         = avtdta(:,:,:,2) 
    264           
    265             CALL eos( tsn, rhd, rhop )   ! Time-filtered in situ density  
    266             CALL bn2( tsn, rn2 )         ! before Brunt-Vaisala frequency 
    267             IF( ln_zps )   & 
    268                &   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
    269                &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level 
    270                    CALL zdf_mxl( kt )              ! mixed layer depth 
    271                    CALL ldf_slp( kt, rhd, rn2 ) 
    272  
     230            tsn(:,:,:,jp_tem) = tdta  (:,:,:,2) 
     231            tsn(:,:,:,jp_sal) = sdta  (:,:,:,2) 
     232            avt(:,:,:)        = avtdta(:,:,:,2) 
     233            ! 
     234                           CALL eos( tsn, rhd, rhop )                   ! now in situ density  
     235                           CALL bn2( tsn, rn2 )                         ! now Brunt-Vaisala frequency 
     236            IF( ln_zps )   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
     237               &                                   rhd, gru , grv   )   ! of t, s, rd at the bottom ocean level 
     238            CALL zdf_mxl( kt )                                          ! mixed layer depth 
     239            CALL ldf_slp( kt, rhd, rn2 )                                ! slope of iso-neutral surfaces 
     240            ! 
    273241            uslpdta (:,:,:,2) = uslp (:,:,:) 
    274242            vslpdta (:,:,:,2) = vslp (:,:,:) 
    … …  
    276244            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    277245         END IF 
    278         
    279          ! store the information of the period read 
    280          ndyn1 = ndyn2 
     246         ! 
     247         ndyn1 = ndyn2         ! store the information of the period read 
    281248         ndyn2 = iper 
    282  
    283          IF (lwp) THEN 
    284             WRITE (numout,*) ' dynamics data read for the period ndyn1 =',ndyn1, & 
    285                &             ' and for the period ndyn2 = ',ndyn2 
     249         ! 
     250         IF(lwp) THEN 
     251            WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,  & 
     252               &             ' and for the period ndyn2 = ', ndyn2 
    286253            WRITE (numout,*) ' time step is : ', kt 
    287254         END IF 
    … …  
    292259      !----------------------------------------      
    293260 
    294       IF( nsptint == 0 ) THEN    
    295          ! No spatial interpolation, data are probably correct 
    296          ! We have to initialize data if we have changed the period          
    297          CALL assign_dyn_data           
    298       ELSE IF( nsptint == 1 ) THEN 
    299          ! linear interpolation 
     261      IF( nsptint == 0 ) THEN          ! No space interpolation, data are probably correct 
     262         !                             ! We have to initialize data if we have changed the period          
     263         CALL assign_dyn_data 
     264      ELSEIF( nsptint == 1 ) THEN      ! linear interpolation 
    300265         CALL linear_interp_dyn_data( zweigh ) 
    301       ELSE  
    302          ! other interpolation 
     266      ELSE                             ! other interpolation 
    303267         WRITE (numout,*) ' this kind of interpolation do not exist at the moment : we stop' 
    304268         STOP 'dtadyn'          
    305269      END IF 
    306        
    307       ! In any case, we need rhop 
    308       CALL eos( tsn, rhd, rhop )  
    309        
     270      ! 
     271      CALL eos( tsn, rhd, rhop )       ! In any case, we need rhop 
     272      ! 
    310273#if ! defined key_degrad && defined key_traldf_c2d 
    311       ! In case of 2D varying coefficients, we need aeiv and aeiu 
     274      !                                ! In case of 2D varying coefficients, we need aeiv and aeiu 
    312275      IF( lk_traldf_eiv )   CALL dta_eiv( kt )      ! eddy induced velocity coefficient 
    313276#endif 
    314  
    315       ! Compute bbl coefficients if needed 
    316       IF( lk_trabbl .AND. .NOT. lk_c1d ) THEN 
     277      ! 
     278      IF( lk_trabbl .AND. .NOT. lk_c1d ) THEN       ! Compute bbl coefficients if needed 
    317279         tsb(:,:,:,:) = tsn(:,:,:,:) 
    318280         CALL bbl( kt, 'TRC') 
    319281      END IF 
    320     
     282      ! 
    321283   END SUBROUTINE dta_dyn 
     284 
    322285 
    323286   SUBROUTINE dynrea( kt, kenr ) 
    … …  
    327290      !! ** Purpose : READ dynamics fiels from OPA9 netcdf output 
    328291      !!  
    329       !! ** Method : READ the kenr records of DATA and store in 
    330       !!             in udta(...,2), ....   
    331       !!  
    332       !! ** History : additions : M. Levy et M. Benjelloul jan 2001  
    333       !!              (netcdf FORMAT)  
    334       !!              05-03 (O. Aumont and A. El Moussaoui) F90 
    335       !!              06-07 : (C. Ethe) use of iom module 
    336       !!---------------------------------------------------------------------- 
    337       !! * Modules used 
    338       USE iom 
    339  
    340       !! * Arguments 
    341       INTEGER, INTENT( in ) ::   kt, kenr       ! time index 
    342       !! * Local declarations 
     292      !! ** Method : READ the kenr records of DATA and store in udta(...,2), ....   
     293      !!---------------------------------------------------------------------- 
     294      INTEGER, INTENT(in) ::   kt, kenr   ! time index 
     295      !! 
    343296      INTEGER ::  jkenr 
    344  
    345       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    346         zu, zv, zw, zt, zs, zavt ,   &     ! 3-D dynamical fields 
    347         zhdiv                              ! horizontal divergence 
    348  
    349       REAL(wp), DIMENSION(jpi,jpj) :: & 
    350          zemp, zqsr, zmld, zice, zwspd, & 
    351          ztaux, ztauy 
    352  
     297      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zu, zv, zw, zt, zs, zavt , zhdiv              ! 3D workspace 
     298      REAL(wp), DIMENSION(jpi,jpj)     ::   zemp, zqsr, zmld, zice, zwspd, ztaux, ztauy   ! 2D workspace 
    353299#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    354300      REAL(wp), DIMENSION(jpi,jpj) :: zaeiw  
    355301#endif 
    356  
    357302#if defined key_degrad 
    358    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    359       zahtu, zahtv, zahtw  !  Lateral diffusivity 
     303   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zahtu, zahtv, zahtw  !  Lateral diffusivity 
    360304# if defined key_traldf_eiv 
    361    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    362       zaeiu, zaeiv, zaeiw  ! G&M coefficient 
     305   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zaeiu, zaeiv, zaeiw  ! G&M coefficient 
    363306# endif 
    364307#endif 
    365  
    366       !--------------------------------------------------------------- 
     308      !!---------------------------------------------------------------------- 
     309 
    367310      ! 0. Initialization 
    368311       
    … …  
    374317      IF(lwp) THEN 
    375318         WRITE(numout,*) 
    376          WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr 
    377          WRITE(numout,*) ' ~~~~~~~' 
     319         WRITE(numout,*) 'Dynrea : read dynamical fields, kenr = ', jkenr 
     320         WRITE(numout,*) '~~~~~~~' 
    378321#if defined key_degrad 
    379322         WRITE(numout,*) ' Degraded fields' 
    … …  
    415358      CALL wzv( zu, zv, zw, zhdiv ) 
    416359 
    417 # if defined key_zdfddm 
    418       CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 
    419 #else 
    420       CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 
    421 #endif  
     360      IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN          ! avs exist: it is used 
     361         CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 
     362      ELSE                                                                       ! no avs: use avt 
     363         CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 
     364      ENDIF 
    422365 
    423366#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    … …  
    473416         CALL iom_close ( numfl_w ) 
    474417      ENDIF 
    475        
     418      !       
    476419   END SUBROUTINE dynrea 
    477420 
     421 
    478422   SUBROUTINE dta_dyn_init 
    479423      !!---------------------------------------------------------------------- 
    … …  
    483427      !! 
    484428      !! ** Method : 
    485       !! 
    486       !! History : 
    487       !!    ! original  : 92-01 (M. Imbard: sub domain) 
    488       !!    ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.) 
    489       !!    ! 98-05 (L. Bopp read output of coupled run) 
    490       !!    ! 05-03 (O. Aumont and A. El Moussaoui) F90 
    491       !!---------------------------------------------------------------------- 
    492       !! * Modules used 
    493  
    494       !! * Local declarations 
    495  
     429      !!---------------------------------------------------------------------- 
    496430      REAL(wp) ::   znspyr   !: number of time step per year 
    497  
     431      !! 
    498432      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  & 
    499433      &                cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
    … …  
    503437      ! ====================================== 
    504438 
    505       ! Read Namelist namdyn : Lateral physics on tracers 
    506       REWIND( numnam ) 
     439      REWIND( numnam )              ! Read Namelist namdyn : Lateral physics on tracers 
    507440      READ  ( numnam, namdyn ) 
    508441 
    509       IF(lwp) THEN 
     442      IF(lwp) THEN                  ! control print 
    510443         WRITE(numout,*) 
    511444         WRITE(numout,*) 'namdyn : offline dynamical selection' 
    … …  
    524457         WRITE(numout,*) ' ' 
    525458      ENDIF 
    526  
     459      ! 
    527460      znspyr   = nyear_len(1) * rday / rdt   
    528461      rnspdta  = znspyr / FLOAT( ndtadyn ) 
    529462      rnspdta2 = rnspdta * 0.5  
    530  
     463      ! 
    531464      CALL dta_dyn( nit000 ) 
    532  
     465      ! 
    533466   END SUBROUTINE dta_dyn_init 
    534467 
     468 
    535469   SUBROUTINE wzv( pu, pv, pw, phdiv ) 
    536470      !!---------------------------------------------------------------------- 
    … …  
    539473      !! ** Purpose :   Compute the now vertical velocity after the array swap 
    540474      !! 
    541       !! ** Method  : 
    542       !! ** Method  : - Divergence: 
    543       !!      - compute the now divergence given by : 
    544       !!         * z-coordinate 
     475      !! ** Method  : - compute the now divergence given by : 
     476      !!         * z-coordinate ONLY !!!! 
    545477      !!         hdiv = 1/(e1t*e2t) [ di(e2u  u) + dj(e1v  v) ] 
    546478      !!     - Using the incompressibility hypothesis, the vertical 
    547479      !!      velocity is computed by integrating the horizontal divergence 
    548480      !!      from the bottom to the surface. 
    549       !!        The boundary conditions are w=0 at the bottom (no flux) and, 
    550       !!      in regid-lid case, w=0 at the sea surface. 
    551       !! 
    552       !! 
    553       !! History : 
    554       !!   9.0  !  02-07  (G. Madec)  Vector optimization 
    555       !!---------------------------------------------------------------------- 
    556       !! * Arguments 
    557       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  )   :: pu, pv    !:  horizontal velocities 
    558       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out )   :: pw        !:  verticla velocity 
    559       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: phdiv     !:  horizontal divergence 
    560  
    561       !! * Local declarations 
     481      !!        The boundary conditions are w=0 at the bottom (no flux). 
     482      !!---------------------------------------------------------------------- 
     483      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities 
     484      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  verticla velocity 
     485      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv     !:  horizontal divergence 
     486      !! 
    562487      INTEGER  ::  ji, jj, jk 
    563488      REAL(wp) ::  zu, zu1, zv, zv1, zet 
    564  
    565  
     489      !!---------------------------------------------------------------------- 
     490      ! 
    566491      ! Computation of vertical velocity using horizontal divergence 
    567492      phdiv(:,:,:) = 0. 
    … …  
    577502            END DO 
    578503         END DO 
    579       ENDDO 
    580  
    581       ! Lateral boundary conditions on phdiv 
    582       CALL lbc_lnk( phdiv, 'T', 1. ) 
    583  
    584  
     504      END DO 
     505      CALL lbc_lnk( phdiv, 'T', 1. )      ! Lateral boundary conditions on phdiv 
     506      ! 
    585507      ! computation of vertical velocity from the bottom 
    586       pw(:,:,jpk) = 0. 
     508      pw(:,:,jpk) = 0._wp 
    587509      DO jk = jpkm1, 1, -1 
    588510         pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * phdiv(:,:,jk) 
    589511      END DO 
    590  
     512      ! 
    591513   END SUBROUTINE wzv 
     514 
    592515 
    593516   SUBROUTINE dta_eiv( kt ) 
    … …  
    600523      !! ** Method : Specific to the offline model. Computes the horizontal 
    601524      !!             values from the vertical value 
    602       !! 
    603       !! History : 
    604       !!   9.0  !  06-03  (O. Aumont)  Free form, F90 
    605       !!---------------------------------------------------------------------- 
    606       !! * Arguments 
     525      !!---------------------------------------------------------------------- 
    607526      INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx 
    608  
    609       !! * Local declarations 
     527      !! 
    610528      INTEGER ::   ji, jj           ! dummy loop indices 
    611529      !!---------------------------------------------------------------------- 
    612  
     530      ! 
    613531      IF( kt == nit000 ) THEN 
    614532         IF(lwp) WRITE(numout,*) 
    … …  
    616534         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    617535      ENDIF 
    618  
     536      ! 
    619537      ! Average the diffusive coefficient at u- v- points 
    620538      DO jj = 2, jpjm1 
    … …  
    624542         END DO 
    625543      END DO 
    626  
    627       ! lateral boundary condition on aeiu, aeiv 
    628       CALL lbc_lnk( aeiu, 'U', 1. ) 
    629       CALL lbc_lnk( aeiv, 'V', 1. ) 
    630  
     544      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition 
     545      ! 
    631546   END SUBROUTINE dta_eiv 
     547 
    632548 
    633549   SUBROUTINE tau2wnd( ptaux, ptauy, pwspd ) 
    … …  
    639555      !! ** Method  : |tau|=rhoa*Cd*|U|^2 
    640556      !!--------------------------------------------------------------------- 
    641       !! * Arguments 
    642       REAL(wp), DIMENSION(jpi,jpj), INTENT( in  ) ::  & 
    643          ptaux, ptauy                              !: wind stress in i-j direction resp. 
    644       REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::  & 
    645          pwspd                                     !: wind speed  
    646       REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3 
    647       REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    648       REAL(wp) ::   ztx, zty, ztau, zcoef ! temporary variables 
    649       INTEGER  ::   ji, jj                ! dummy indices 
     557      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptaux, ptauy   ! wind stress in i-j direction resp. 
     558      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pwspd          ! wind speed 
     559      !!  
     560      REAL(wp) ::   zrhoa  = 1.22_wp       ! Air density kg/m3 
     561      REAL(wp) ::   zcdrag = 1.5e-3_wp     ! drag coefficient 
     562      REAL(wp) ::   ztx, zty, ztau, zcoef  ! temporary variables 
     563      INTEGER  ::   ji, jj                 ! dummy indices 
    650564      !!--------------------------------------------------------------------- 
    651565      zcoef = 1. / ( zrhoa * zcdrag ) 
    … …  
    661575      END DO 
    662576      CALL lbc_lnk( pwspd(:,:), 'T', 1. ) 
    663  
     577      ! 
    664578   END SUBROUTINE tau2wnd 
    665579 
     580 
    666581   SUBROUTINE swap_dyn_data 
    667582      !!---------------------------------------------------------------------- 
    … …  
    669584      !! 
    670585      !! ** Purpose :   swap array data 
    671       !! 
    672       !! History : 
    673       !!   9.0  !  07-09  (C. Ethe) 
    674       !!---------------------------------------------------------------------- 
    675  
    676  
     586      !!---------------------------------------------------------------------- 
     587      ! 
    677588      ! swap from record 2 to 1 
    678589      tdta   (:,:,:,1) = tdta   (:,:,:,2) 
    … …  
    709620#  endif 
    710621#endif 
    711  
     622      ! 
    712623   END SUBROUTINE swap_dyn_data 
     624 
    713625 
    714626   SUBROUTINE assign_dyn_data 
    … …  
    728640      vn (:,:,:) = vdta  (:,:,:,2) 
    729641      wn (:,:,:) = wdta  (:,:,:,2) 
    730  
    731 #if defined key_zdfddm 
    732       avs(:,:,:)   = avtdta (:,:,:,2) 
    733 #endif 
    734  
    735642       
    736643#if defined key_ldfslp && ! defined key_c1d 
    … …  
    761668      aeiw(:,:,:) = aeiwdta(:,:,:,2) 
    762669#  endif 
    763        
    764 #endif 
    765        
     670#endif 
     671      ! 
    766672   END SUBROUTINE assign_dyn_data 
    767673 
     674 
    768675   SUBROUTINE linear_interp_dyn_data( pweigh ) 
    769676      !!---------------------------------------------------------------------- 
    770       !!                    ***  ROUTINE linear_interp_dyn_data  *** 
     677      !!               ***  ROUTINE linear_interp_dyn_data  *** 
    771678      !! 
    772679      !! ** Purpose :   linear interpolation of data 
    773       !! 
    774       !!---------------------------------------------------------------------- 
    775       !! * Argument 
    776       REAL(wp), INTENT( in ) ::   pweigh       ! weigh 
    777  
    778       !! * Local declarations 
     680      !!---------------------------------------------------------------------- 
     681      REAL(wp), INTENT(in) ::   pweigh   ! weigh 
     682      !! 
    779683      REAL(wp) :: zweighm1 
    780684      !!---------------------------------------------------------------------- 
    … …  
    789693      vn (:,:,:) = zweighm1 * vdta  (:,:,:,1) + pweigh * vdta  (:,:,:,2) 
    790694      wn (:,:,:) = zweighm1 * wdta  (:,:,:,1) + pweigh * wdta  (:,:,:,2) 
    791  
    792 #if defined key_zdfddm 
    793       avs(:,:,:)   = zweighm1 * avtdta (:,:,:,1) + pweigh * avtdta (:,:,:,2) 
    794 #endif 
    795  
    796695       
    797696#if defined key_ldfslp && ! defined key_c1d 
    … …  
    823722#  endif 
    824723#endif 
    825        
     724      !       
    826725   END SUBROUTINE linear_interp_dyn_data 
    827726 
     727   !!====================================================================== 
    828728END MODULE dtadyn 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/istate.F90

    r2287 r2444  
    22   !!====================================================================== 
    33   !!                     ***  MODULE  istate  *** 
    4    !! Ocean state   :  initial state setting 
     4   !! Ocean state   :  initial state setting, off-line case 
    55   !!===================================================================== 
     6   !! History :  3.3  ! 2010-10  (C. Ethe)  original code 
     7   !!---------------------------------------------------------------------- 
    68 
    79   !!---------------------------------------------------------------------- 
    8    !!   istate_init   : initial state setting 
     10   !!   istate_init   : initial state set to zero 
    911   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1112   USE oce             ! ocean dynamics and active tracers  
    1213   USE dom_oce         ! ocean space and time domain  
    13    USE ldftra_oce      ! ocean active tracers: lateral physics 
    14    USE zdf_oce         ! ocean vertical physics 
    15    USE in_out_manager  ! I/O manager 
    16    USE phycst          ! physical constants 
    1714 
    1815   IMPLICIT NONE 
    1916   PRIVATE 
    2017 
    21    !! * Routine accessibility 
    22    PUBLIC istate_init   ! routine called by step.F90 
     18   PUBLIC   istate_init   ! routine called by step.F90 
    2319 
    2420   !! * Substitutions 
    … …  
    2824   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    2925   !! $Id$ 
    30    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    31    !!---------------------------------------------------------------------- 
    32  
     26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     27   !!--------------------------------------------------------------------- 
    3328CONTAINS 
    3429 
    … …  
    3732      !!                   ***  ROUTINE istate_init  *** 
    3833      !!  
    39       !! ** Purpose :   Initialization of the dynamics and tracers. 
    40       !! 
    41       !! ** Method  : 
    42       !! 
    43       !! History : 
    44       !!   4.0  !  91-03  ()  Original code 
    45       !!        !  91-11  (G. Madec) 
    46       !!   9.0  !  03-09  (G. Madec)  F90: Free form, modules, orthogonality 
     34      !! ** Purpose :   Initialization to zero of the dynamics and tracers. 
    4735      !!---------------------------------------------------------------------- 
    48       !! * Local declarations 
    49       !!---------------------------------------------------------------------- 
    50  
    51  
    52       ! Initialization to zero 
    53       ! ---------------------- 
    54  
    55       !     before fields       !       now fields        !      after fields       ! 
    56       ;   un   (:,:,:) = 0.e0   ;   ua   (:,:,:) = 0.e0 
    57       ;   vn   (:,:,:) = 0.e0   ;   va   (:,:,:) = 0.e0 
    58       ;                         ;   wn   (:,:,:) = 0.e0    
    59       ;   hdivn(:,:,:) = 0.e0   ; 
    60  
    61       ;   tsn  (:,:,:,:) = 0.e0  
    62  
     36      ! 
     37      !     now fields         !     after fields      ! 
     38      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   ! 
     39      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   ! 
     40      wn   (:,:,:)   = 0._wp   !                       ! 
     41      hdivn(:,:,:)   = 0._wp   !                       ! 
     42      tsn  (:,:,:,:) = 0._wp   !                       ! 
     43      ! 
    6344      rhd  (:,:,:) = 0.e0 
    6445      rhop (:,:,:) = 0.e0 
    6546      rn2  (:,:,:) = 0.e0  
    66  
    67  
     47      ! 
    6848   END SUBROUTINE istate_init 
    6949 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/opa.F90

    r2431 r2444  
    11MODULE opa 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE opa   *** 
    4    !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice) 
    5    !!============================================================================== 
    6  
    7    !!---------------------------------------------------------------------- 
    8    !!   opa_model      : solve ocean dynamics, tracer and/or sea-ice 
    9    !!---------------------------------------------------------------------- 
    10    !! * Modules used 
     4   !! Off-line Ocean   : passive tracer evolution, dynamics read in files 
     5   !!====================================================================== 
     6   !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line: phasing with the on-line 
     7   !!---------------------------------------------------------------------- 
     8 
     9   !!---------------------------------------------------------------------- 
     10   !!   opa_model      : off-line: solve ocean tracer only 
     11   !!   opa_init       : initialization of the opa model 
     12   !!   opa_ctl        : initialisation of algorithm flag  
     13   !!   opa_closefile  : close remaining files 
     14   !!---------------------------------------------------------------------- 
    1115   USE dom_oce         ! ocean space domain variables 
    1216   USE oce             ! dynamics and tracers variables 
    13    USE in_out_manager  ! I/O manager 
    14    USE lib_mpp         ! distributed memory computing 
    15  
     17   USE c1d             ! 1D configuration 
    1618   USE domcfg          ! domain configuration               (dom_cfg routine) 
    17    USE mppini          ! shared/distributed memory setting (mpp_init routine) 
    1819   USE domain          ! domain initialization             (dom_init routine) 
    1920   USE istate          ! initial state setting          (istate_init routine) 
    2021   USE eosbn2          ! equation of state            (eos bn2 routine) 
    21  
    22    ! ocean physics 
     22   !              ! ocean physics 
    2323   USE ldftra          ! lateral diffusivity setting    (ldf_tra_init routine) 
    2424   USE ldfslp          ! slopes of neutral surfaces     (ldf_slp_init routine) 
    … …  
    2626   USE trabbl          ! bottom boundary layer          (tra_bbl_init routine) 
    2727   USE zpshde          ! partial step: hor. derivative  (zps_hde_init routine) 
    28    USE zdfini 
    29    USE zdfddm 
    30    USE zdfkpp 
    31  
     28   USE zdfini          ! vertical physics: initialization 
    3229   USE phycst          ! physical constant                  (par_cst routine) 
    3330   USE dtadyn          ! Lecture and Interpolation of the dynamical fields 
    3431   USE trcini          ! Initilization of the passive tracers 
    35    USE stpctl 
    3632   USE daymod          ! calendar                         (day     routine) 
    3733   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    3834   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
    3935   USE stpctl          ! time stepping control            (stp_ctl routine) 
    40  
    41    USE c1d             ! 1D configuration 
    42  
    43    USE iom 
     36   !              ! I/O & MPP 
     37   USE iom             ! I/O library 
     38   USE in_out_manager  ! I/O manager 
     39   USE mppini          ! shared/distributed memory setting (mpp_init routine) 
     40   USE lib_mpp         ! distributed memory computing 
    4441#if defined key_iomput 
    4542   USE  mod_ioclient 
    … …  
    4845   IMPLICIT NONE 
    4946   PRIVATE 
    50  
    51    !! * Module variables 
    52    CHARACTER (len=64) ::        & 
    53       cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    54  
    55    !! * Routine accessibility 
    56    PUBLIC opa_model      ! called by model.F90 
    57    PUBLIC opa_init 
     47    
     48   PUBLIC   opa_model   ! called by model.F90 
     49 
     50   CHARACTER (len=64) ::   cform_aaa="( /, 'AAAAAAAA', / ) "   ! flag for output listing 
     51 
    5852   !!---------------------------------------------------------------------- 
    5953   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    6054   !! $Id$ 
    61    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    62    !!---------------------------------------------------------------------- 
    63  
     55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     56   !!---------------------------------------------------------------------- 
    6457CONTAINS 
    6558 
    … …  
    7265      !! 
    7366      !! ** Method  : - model general initialization 
    74       !!              - launch the time-stepping (stp routine) 
    75       !! 
    76       !! References : 
    77       !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 
    78       !!              internal report, IPSL. 
     67      !!              - launch the time-stepping (dta_dyn and trc_stp) 
     68      !!              - finalize the run by closing files and communications 
     69      !! 
     70      !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL. 
     71      !!              Madec, 2008, internal report, IPSL. 
    7972      !!---------------------------------------------------------------------- 
    8073      INTEGER :: istp, indic       ! time step index 
    … …  
    8982      IF( lk_mpp )   CALL mpp_max( nstop ) 
    9083 
     84      !                            !-----------------------! 
     85      !                            !==   time stepping   ==! 
     86      !                            !-----------------------! 
    9187      istp = nit000 
    9288         ! 
    93       DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    94          ! 
    95          IF( istp /= nit000 )   CALL day      ( istp )   ! Calendar (day was already called at nit000 in day_init) 
    96                                 CALL iom_setkt( istp )   ! say to iom that we are at time step kstp 
    97                                 CALL dta_dyn  ( istp )   ! Interpolation of the dynamical fields 
    98                                 CALL trc_stp  ( istp )   ! time-stepping 
    99                                 CALL stp_ctl  ( istp, indic )   ! Time loop: control and print 
     89      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
     90         ! 
     91         IF( istp /= nit000 )   CALL day      ( istp )         ! Calendar (day was already called at nit000 in day_init) 
     92                                CALL iom_setkt( istp )         ! say to iom that we are at time step kstp 
     93                                CALL dta_dyn  ( istp )         ! Interpolation of the dynamical fields 
     94                                CALL trc_stp  ( istp )         ! time-stepping 
     95                                CALL stp_ctl  ( istp, indic )  ! Time loop: control and print 
    10096         istp = istp + 1 
    10197         IF( lk_mpp )   CALL mpp_max( nstop ) 
    10298      END DO 
    103       !                                     ! ========= ! 
    104       !                                     !  Job end  ! 
    105       !                                     ! ========= ! 
    106  
    107       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     99 
     100      !                            !------------------------! 
     101      !                            !==  finalize the run  ==! 
     102      !                            !------------------------! 
     103      IF(lwp) WRITE(numout,cform_aaa)                 ! Flag AAAAAAA 
    108104 
    109105      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print 
    … …  
    111107         WRITE(numout,*) nstop, ' error have been found' 
    112108      ENDIF 
    113  
     109      ! 
    114110      CALL opa_closefile 
    115  
     111      ! 
    116112      IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp) 
    117113      ! 
    … …  
    123119      !!                     ***  ROUTINE opa_init *** 
    124120      !! 
    125       !! ** Purpose :   opa solves the primitive equations on an orthogonal  
    126       !!      curvilinear mesh on the sphere. 
    127       !! 
    128       !! ** Method  : - model general initialization 
    129       !! 
    130       !! References : 
    131       !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 
    132       !!              internal report, IPSL. 
    133       !! 
    134       !! History : 
    135       !!   4.0  !  90-10  (C. Levy, G. Madec)  Original code 
    136       !!   7.0  !  91-11  (M. Imbard, C. Levy, G. Madec) 
    137       !!   7.1  !  93-03  (M. Imbard, C. Levy, G. Madec, O. Marti, 
    138       !!                   M. Guyon, A. Lazar, P. Delecluse, C. Perigaud, 
    139       !!                   G. Caniaux, B. Colot, C. Maes ) release 7.1  
    140       !!        !  92-06  (L.Terray) coupling implementation 
    141       !!        !  93-11  (M.A. Filiberti) IGLOO sea-ice  
    142       !!   8.0  !  96-03  (M. Imbard, C. Levy, G. Madec, O. Marti, 
    143       !!                   M. Guyon, A. Lazar, P. Delecluse, L.Terray, 
    144       !!                   M.A. Filiberti, J. Vialar, A.M. Treguier, 
    145       !!                   M. Levy)  release 8.0 
    146       !!   8.1  !  97-06  (M. Imbard, G. Madec) 
    147       !!   8.2  !  99-11  (M. Imbard, H. Goosse)  LIM sea-ice model  
    148       !!        !  99-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP  
    149       !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    150       !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules 
    151       !!---------------------------------------------------------------------- 
    152       !! * Local declarations 
    153 #if defined key_oasis3 || defined key_oasis4 || defined key_iomput 
    154       INTEGER :: ilocal_comm 
    155 #endif 
    156       CHARACTER(len=80),dimension(10) ::   cltxt = '' 
    157       INTEGER                         ::   ji   ! local loop indices 
     121      !! ** Purpose :   initialization of the opa model in off-line mode 
     122      !!---------------------------------------------------------------------- 
     123      INTEGER ::   ji            ! dummy loop indices 
     124      INTEGER ::   ilocal_comm   ! local integer 
     125      CHARACTER(len=80), DIMENSION(10) ::   cltxt = '' 
    158126      !! 
    159127      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    160128         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 
    161129      !!---------------------------------------------------------------------- 
    162  
    163130      ! 
    164131      !                             ! open Namelist file      
    … …  
    171138      !                             !--------------------------------------------! 
    172139#if defined key_iomput 
    173 # if defined key_oasis3 || defined key_oasis4    
    174       CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    175       CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
    176 # else 
    177140      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
    178 # endif 
    179141      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
    180  
    181142#else 
    182 # if defined key_oasis3 || defined key_oasis4    
    183       CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    184       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt) 
    185 # else 
    186143      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt) 
    187 # endif 
    188144#endif 
    189145      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 ) 
    … …  
    199155         WRITE(numout,*) '                       NEMO team' 
    200156         WRITE(numout,*) '            Ocean General Circulation Model' 
    201          WRITE(numout,*) '                  version 3.2  (2009) ' 
     157         WRITE(numout,*) '                  version 3.3  (2010) ' 
    202158         WRITE(numout,*) 
    203159         WRITE(numout,*) 
    … …  
    208164         ! 
    209165      ENDIF 
    210  
    211       CALL opa_flg                          ! Control prints & Benchmark 
    212  
    213       !                                     ! ============================== ! 
    214       !                                     !  Model general initialization  ! 
    215       !                                     ! ============================== ! 
    216  
    217       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    218  
    219                                             ! Domain decomposition 
    220                                             ! Domain decomposition 
     166      !                             !--------------------------------! 
     167      !                             !  Model general initialization  ! 
     168      !                             !--------------------------------! 
     169 
     170      CALL opa_ctl                           ! Control prints & Benchmark 
     171 
     172      !                                      ! Domain decomposition 
    221173      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
    222174      ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    223175      ENDIF 
    224  
    225  
    226  
    227       !                                     ! General initialization 
     176      ! 
     177      !                                      ! General initialization 
    228178                            CALL     phy_cst    ! Physical constants 
    229179                            CALL     eos_init   ! Equation of state 
    … …  
    235185 
    236186      !                                     ! Ocean physics 
    237       IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
    238          &                  CALL zdf_ddm_init   ! double diffusive mixing 
    239187#if ! defined key_degrad 
    240188                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
    … …  
    253201 
    254202      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    255  
     203      ! 
    256204   END SUBROUTINE opa_init 
    257205 
    258    SUBROUTINE opa_flg 
    259       !!---------------------------------------------------------------------- 
    260       !!                     ***  ROUTINE opa  *** 
    261       !! 
    262       !! ** Purpose :   Initialise logical flags that control the choice of 
    263       !!              some algorithm or control print 
    264       !! 
    265       !! ** Method  : - print namctl information 
    266       !!              - Read in namilist namflg logical flags 
    267       !!---------------------------------------------------------------------- 
    268  
    269       IF(lwp) THEN                 ! Parameter print 
     206 
     207   SUBROUTINE opa_ctl 
     208      !!---------------------------------------------------------------------- 
     209      !!                     ***  ROUTINE opa_ctl  *** 
     210      !! 
     211      !! ** Purpose :   control print setting  
     212      !! 
     213      !! ** Method  : - print namctl information and check some consistencies 
     214      !!---------------------------------------------------------------------- 
     215      ! 
     216      IF(lwp) THEN                  ! Parameter print 
    270217         WRITE(numout,*) 
    271218         WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 
    … …  
    282229         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
    283230      ENDIF 
    284  
     231      ! 
    285232      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    286233      nictls    = nn_ictls 
    … …  
    291238      jsplt     = nn_jsplt 
    292239      nbench    = nn_bench 
    293       !                           ! Parameter control 
     240      !                             ! Parameter control 
    294241      ! 
    295242      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints 
    … …  
    329276         ENDIF 
    330277      ENDIF 
    331  
     278      ! 
    332279      IF( nbench == 1 )   THEN            ! Benchmark  
    333280         SELECT CASE ( cp_cfg ) 
    … …  
    338285      ENDIF 
    339286      ! 
    340       IF( lk_c1d .AND. .NOT. lk_iomput )  & 
    341         CALL ctl_stop( ' The 1D vertical configuration must be used in conjunction',   & 
    342             &          ' with the IOM Input/Output manager. Compile with key_iomput enabled' ) 
    343       ! 
    344  
    345    END SUBROUTINE opa_flg 
     287      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'opa_ctl: The 1D configuration must be used ',   & 
     288         &                                               'with the IOM Input/Output manager. '        ,   & 
     289         &                                               'Compile with key_iomput enabled' ) 
     290      ! 
     291   END SUBROUTINE opa_ctl 
     292 
    346293 
    347294   SUBROUTINE opa_closefile 
    … …  
    350297      !! 
    351298      !! ** Purpose :   Close the files 
    352       !! 
    353       !! ** Method  : 
    354       !! 
    355       !! History : 
    356       !!   9.0  !  05-01  (O. Le Galloudec)  Original code 
    357       !!---------------------------------------------------------------------- 
    358       !!---------------------------------------------------------------------- 
    359  
     299      !!---------------------------------------------------------------------- 
     300      ! 
    360301      IF ( lk_mpp ) CALL mppsync 
    361  
    362       ! 1. Unit close 
    363       ! ------------- 
    364  
    365       CLOSE( numnam )           ! namelist 
    366       CLOSE( numout )           ! standard model output file 
    367  
    368       IF(lwp) CLOSE( numstp )   ! time-step file 
    369  
    370       CALL iom_close            ! close all input/output files 
    371  
     302      ! 
     303      CALL iom_close                                 ! close all input/output files managed by iom_* 
     304      ! 
     305      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file 
     306      IF( numnam     /= -1 )   CLOSE( numnam     )   ! oce namelist 
     307      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file 
     308      numout = 6                                     ! redefine numout in case it is used after this point... 
     309      ! 
    372310   END SUBROUTINE opa_closefile 
    373311 

  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OFF_SRC/stpctl.F90

    r2287 r2444  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  stpctl  *** 
    4    !! Ocean run control :  gross check of the ocean time stepping 
     4   !! Ocean run control :  Off-line case, only save the time step in numstp 
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1991-03  (G. Madec) Original code 
    … …  
    2323   PRIVATE 
    2424 
    25    PUBLIC stp_ctl           ! routine called by step.F90 
     25   PUBLIC   stp_ctl    ! routine called by opa.F90 
     26    
    2627   !!---------------------------------------------------------------------- 
    2728   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    2829   !! $Id$ 
    29    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3031   !!---------------------------------------------------------------------- 
    31  
    3232CONTAINS 
    3333 
    … …  
    3939      !! 
    4040      !! ** Method  : - Save the time step in numstp 
    41       !!              - Print it each 50 time steps 
    4241      !! 
    4342      !! ** Actions :   'time.step' file containing the last ocean time-step 
    44       !!                 
    4543      !!---------------------------------------------------------------------- 
    46       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    47       INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence 
     44      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index 
     45      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence 
    4846      !!---------------------------------------------------------------------- 
    49  
     47      ! 
    5048      IF( kt == nit000 .AND. lwp ) THEN 
    5149         WRITE(numout,*) 
    … …  
    5553         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    5654      ENDIF 
    57  
     55      ! 
    5856      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
    5957      IF(lwp) REWIND( numstp )                       !  -------------------------- 
    60  
    6158      ! 
    6259   END SUBROUTINE stp_ctl 
Note: See TracChangeset for help on using the changeset viewer.