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 2528 for trunk/NEMOGCM/NEMO/OFF_SRC – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

Location:
trunk/NEMOGCM/NEMO/OFF_SRC
Files:
34 deleted
4 edited
3 copied

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90

    • Property svn:eol-style deleted
    r1735 r2528  
    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 
     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 
     26   USE phycst          ! physical constants 
     27   USE trabbl          ! active tracer: bottom boundary layer 
     28   USE ldfslp          ! lateral diffusion: iso-neutral slopes 
     29   USE ldfeiv          ! eddy induced velocity coef.  
     30   USE ldftra_oce      ! ocean tracer   lateral physics 
     31   USE zdfmxl          ! vertical physics: mixed layer depth 
     32   USE eosbn2          ! equation of state - Brunt Vaisala frequency 
     33   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     34   USE zpshde          ! z-coord. with partial steps: horizontal derivatives 
    1535   USE in_out_manager  ! I/O manager 
    16    USE phycst          ! physical constants 
    17    USE sbc_oce 
    18    USE ldfslp 
    19    USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine) 
    20    USE ldftra_oce      ! ocean tracer   lateral physics 
    21    USE zdfmxl 
    22    USE trabbl 
    23    USE eosbn2 
    24    USE zdfddm          ! vertical  physics: double diffusion 
    25    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    26    USE zpshde 
     36   USE iom             ! I/O library 
    2737   USE lib_mpp         ! distributed memory computing library 
     38   USE prtctl          !  print control 
    2839 
    2940   IMPLICIT NONE 
    3041   PRIVATE 
    3142 
    32    !! *  Routine accessibility 
    33    PUBLIC dta_dyn_init   ! called by opa.F90 
    34    PUBLIC dta_dyn        ! called by step.F90 
    35  
    36    LOGICAL , PUBLIC :: & 
    37       lperdyn = .TRUE. , & ! boolean for periodic fields or not 
    38       lfirdyn = .TRUE.     ! boolean for the first call or not 
    39  
    40    INTEGER , PUBLIC :: & 
    41       ndtadyn = 73 ,  & ! Number of dat in one year 
    42       ndtatot = 73 ,  & ! Number of data in the input field 
    43       nsptint = 1 ,   & ! type of spatial interpolation 
    44       nficdyn = 2       ! number of dynamical fields  
    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 
     43   PUBLIC   dta_dyn_init   ! called by opa.F90 
     44   PUBLIC   dta_dyn        ! called by step.F90 
     45 
     46   LOGICAL, PUBLIC ::   lperdyn = .TRUE.   !: boolean for periodic fields or not 
     47   LOGICAL, PUBLIC ::   lfirdyn = .TRUE.   !: boolean for the first call or not 
     48 
     49   INTEGER, PUBLIC ::   ndtadyn = 73       !: Number of dat in one year 
     50   INTEGER, PUBLIC ::   ndtatot = 73       !: Number of data in the input field 
     51   INTEGER, PUBLIC ::   nsptint = 1        !: type of spatial interpolation 
     52 
     53   CHARACTER(len=45) ::   cfile_grid_T = 'dyna_grid_T.nc'   ! name of the grid_T file 
     54   CHARACTER(len=45) ::   cfile_grid_U = 'dyna_grid_U.nc'   ! name of the grid_U file 
     55   CHARACTER(len=45) ::   cfile_grid_V = 'dyna_grid_V.nc'   ! name of the grid_V file 
     56   CHARACTER(len=45) ::   cfile_grid_W = 'dyna_grid_W.nc'   ! name of the grid_W file 
    5157    
    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 #if defined key_trc_diatrd 
    69       hdivdta,   & ! horizontal divergence 
    70 #endif 
    71       avtdta       ! vertical diffusivity coefficient 
    72  
    73    REAL(wp), DIMENSION(jpi,jpj,2) ::       & 
    74       hmlddta,   & ! mixed layer depth at two consecutive times 
    75       wspddta,   & ! wind speed at two consecutive times 
    76       frlddta,   & ! sea-ice fraction at two consecutive times 
    77       empdta ,   & ! E-P at two consecutive times 
    78       qsrdta       ! short wave heat flux at two consecutive times 
    79  
     58   REAL(wp) ::   rnspdta    ! number of time step per 2 consecutives data 
     59   REAL(wp) ::   rnspdta2   ! rnspdta * 0.5 
     60 
     61   INTEGER ::   ndyn1, ndyn2    ! 
     62   INTEGER ::   nlecoff = 0     ! switch for the first read 
     63   INTEGER ::   numfl_t, numfl_u, numfl_v, numfl_w 
     64 
     65   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: tdta       ! temperature at two consecutive times 
     66   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: sdta       ! salinity at two consecutive times 
     67   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: udta       ! zonal velocity at two consecutive times 
     68   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vdta       ! meridional velocity at two consecutive times 
     69   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wdta       ! vertical velocity at two consecutive times 
     70   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: avtdta     ! vertical diffusivity coefficient 
     71 
     72   REAL(wp), DIMENSION(jpi,jpj    ,2) :: hmlddta    ! mixed layer depth at two consecutive times 
     73   REAL(wp), DIMENSION(jpi,jpj    ,2) :: wspddta    ! wind speed at two consecutive times 
     74   REAL(wp), DIMENSION(jpi,jpj    ,2) :: frlddta    ! sea-ice fraction at two consecutive times 
     75   REAL(wp), DIMENSION(jpi,jpj    ,2) :: empdta     ! E-P at two consecutive times 
     76   REAL(wp), DIMENSION(jpi,jpj    ,2) :: qsrdta     ! short wave heat flux at two consecutive times 
     77   REAL(wp), DIMENSION(jpi,jpj    ,2) :: bblxdta    ! frequency of bbl in the x direction at 2 consecutive times  
     78   REAL(wp), DIMENSION(jpi,jpj    ,2) :: bblydta    ! frequency of bbl in the y direction at 2 consecutive times  
     79   LOGICAL :: l_offbbl 
    8080#if defined key_ldfslp 
    81    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    82       uslpdta ,  & ! zonal isopycnal slopes 
    83       vslpdta ,  & ! meridional isopycnal slopes 
    84       wslpidta , & ! zonal diapycnal slopes 
    85       wslpjdta     ! meridional diapycnal slopes 
    86 #endif 
    87  
    88 #if ! defined key_off_degrad &&  defined key_traldf_c2d 
    89    REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    90       ahtwdta      ! Lateral diffusivity 
    91 # if defined key_trcldf_eiv  
    92    REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    93       aeiwdta      ! G&M coefficient 
     81   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: uslpdta    ! zonal isopycnal slopes 
     82   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: vslpdta    ! meridional isopycnal slopes 
     83   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpidta   ! zonal diapycnal slopes 
     84   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: wslpjdta   ! meridional diapycnal slopes 
     85#endif 
     86#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv  
     87   REAL(wp), DIMENSION(jpi,jpj    ,2) :: aeiwdta    ! G&M coefficient 
     88#endif 
     89#if defined key_degrad 
     90   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: ahtudta, ahtvdta, ahtwdta   ! Lateral diffusivity 
     91# if defined key_traldf_eiv 
     92   REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: aeiudta, aeivdta, aeiwdta   ! G&M coefficient 
    9493# endif 
    95 #endif 
    96  
    97 #if defined key_off_degrad 
    98    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    99       ahtudta, ahtvdta, ahtwdta  !  Lateral diffusivity 
    100 # if defined key_trcldf_eiv 
    101    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    102       aeiudta, aeivdta, aeiwdta  ! G&M coefficient 
    103 # endif 
    104  
    105 #endif 
    106  
    107 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    108    REAL(wp), DIMENSION(jpi,jpj,2) ::       & 
    109       bblxdta ,  & ! frequency of bbl in the x direction at 2 consecutive times 
    110       bblydta      ! frequency of bbl in the y direction at 2 consecutive times 
    11194#endif 
    11295 
     
    11598#  include "vectopt_loop_substitute.h90" 
    11699   !!---------------------------------------------------------------------- 
    117    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    118    !!   $Id$ 
    119    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     100   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     101   !! $Id$ 
     102   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    120103   !!---------------------------------------------------------------------- 
    121  
    122104CONTAINS 
    123105 
     
    126108      !!                  ***  ROUTINE dta_dyn  *** 
    127109      !! 
    128       !! ** Purpose : Prepares dynamics and physics fields from an  
    129       !!              OPA9 simulation  for an off-line simulation 
    130       !!               for passive tracer 
     110      !! ** Purpose :   Prepares dynamics and physics fields from an NEMO run 
     111      !!              for an off-line simulation of passive tracers 
    131112      !! 
    132113      !! ** Method : calculates the position of DATA to read READ DATA  
    133114      !!             (example month changement) computes slopes IF needed 
    134115      !!             interpolates DATA IF needed 
    135       !! 
    136       !! ** History : 
    137       !!   ! original  : 92-01 (M. Imbard: sub domain) 
    138       !!   ! addition  : 98-04 (L.Bopp MA Foujols: slopes for isopyc.)  
    139       !!   ! addition  : 98-05 (L. Bopp read output of coupled run) 
    140       !!   ! addition  : 05-03 (O. Aumont and A. El Moussaoui) F90 
    141       !!   ! addition  : 05-12 (C. Ethe) Adapted for DEGINT 
    142       !!---------------------------------------------------------------------- 
    143       !! * Arguments 
    144       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    145  
    146       !! * Local declarations 
    147       INTEGER ::   iper, iperm1, iswap, izt    
    148  
    149       REAL(wp) :: zpdtan, zpdtpe, zdemi, zt 
    150       REAL(wp) :: zweigh 
    151  
    152       ! 0. Initialization 
    153       ! ----------------- 
    154  
    155       IF( lfirdyn ) THEN 
    156          ! first time step MUST BE nit000 
    157          IF( kt /= nit000 ) THEN 
    158             IF (lwp) THEN  
    159                WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt = ',kt ,' nit000 = ',nit000  
    160               STOP 'dtadyn' 
    161             ENDIF 
    162           ENDIF  
    163           ! Initialize the parameters of the interpolation 
    164           CALL dta_dyn_init 
    165       ENDIF 
    166  
    167       zt       = ( FLOAT (kt) + rnspdta2 ) / rnspdta 
    168       izt      = INT( zt ) 
    169       zweigh   = zt - FLOAT( INT(zt) ) 
    170  
    171       IF( lperdyn ) THEN 
    172          iperm1 = MOD( izt, ndtadyn ) 
    173       ELSE 
    174          iperm1 = MOD( izt, ndtatot - 1 ) + 1 
     116      !!---------------------------------------------------------------------- 
     117      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     118      !! 
     119      INTEGER  ::   iper, iperm1, iswap, izt   ! local integers  
     120      REAL(wp) ::   zt, zweigh                 ! local scalars 
     121      !!---------------------------------------------------------------------- 
     122 
     123      zt     = ( REAL(kt,wp) + rnspdta2 ) / rnspdta 
     124      izt    = INT( zt ) 
     125      zweigh = zt - REAL( INT(zt), wp ) 
     126 
     127      IF( lperdyn ) THEN   ;   iperm1 = MOD( izt, ndtadyn ) 
     128      ELSE                 ;   iperm1 = MOD( izt, ndtatot - 1 ) + 1 
    175129      ENDIF 
    176130 
     
    181135          ELSE  
    182136              IF( lfirdyn ) THEN  
    183                   IF (lwp) WRITE (numout,*) &  
    184                       &   ' dynamic file is not periodic with or without interpolation  & 
    185                       &   we take the first value for the previous period iperm1 = 0  ' 
     137                  IF(lwp) WRITE (numout,*) 'dta_dyn:  dynamic file is not periodic with or without interpolation    & 
     138                     &                                we take the first value for the previous period iperm1 = 0  ' 
    186139              END IF 
    187140          END IF  
     
    194147 
    195148      IF( lfirdyn ) THEN 
    196          ! store the information of the period read 
    197          ndyn1 = iperm1 
     149         ndyn1 = iperm1         ! store the information of the period read 
    198150         ndyn2 = iper 
    199151          
    200          IF (lwp) THEN 
    201             WRITE (numout,*) ' dynamics data read for the period ndyn1 =',ndyn1, & 
    202                &             ' and for the period ndyn2 = ',ndyn2 
     152         IF(lwp) THEN 
     153            WRITE (numout,*) ' dynamics data read for the period ndyn1 =', ndyn1,  & 
     154               &             ' and for the period ndyn2 = ', ndyn2 
    203155            WRITE (numout,*) ' time step is : ', kt 
    204             WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,' records in the dynamic file for one year' 
     156            WRITE (numout,*) ' we have ndtadyn = ', ndtadyn, ' records in the dynamic file for one year' 
    205157         END IF 
    206158         ! 
    207          IF( iperm1 /= 0 ) THEN         ! data read for the iperm1 period 
    208             CALL dynrea( kt, iperm1 )  
    209          ELSE  
    210             CALL dynrea( kt, 1 ) 
    211          ENDIF 
     159         CALL dynrea( kt, MAX( 1, iperm1) )           ! data read for the iperm1 period 
    212160          
    213 #if defined key_ldfslp 
    214          ! Computes slopes 
    215          ! Caution : here tn, sn and avt are used as workspace 
    216          tn (:,:,:) = tdta  (:,:,:,2) 
    217          sn (:,:,:) = sdta  (:,:,:,2) 
    218          avt(:,:,:) = avtdta(:,:,:,2) 
     161         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN      ! Computes slopes (here tsn and avt are used as workspace) 
     162            tsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
     163            tsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
     164            avt(:,:,:)         = avtdta(:,:,:,2) 
    219165          
    220          CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
    221          CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
    222          IF( ln_zps )   & 
    223             &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
    224             &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
    225             &                 gtv, gsv, grv ) 
    226          CALL zdf_mxl( kt )              ! mixed layer depth 
    227          CALL ldf_slp( kt, rhd, rn2 ) 
     166            CALL eos( tsn, rhd, rhop )   ! Time-filtered in situ density  
     167            CALL bn2( tsn, rn2 )         ! before Brunt-Vaisala frequency 
     168            IF( ln_zps )   & 
     169               &   CALL zps_hde( kt, jpts, tsn, gtsu, gtsv,  &  ! Partial steps: before Horizontal DErivative 
     170               &                           rhd, gru , grv   )    ! of t, s, rd at the bottom ocean level 
     171            CALL zdf_mxl( kt )           ! mixed layer depth 
     172            CALL ldf_slp( kt, rhd, rn2 ) 
    228173          
    229          uslpdta (:,:,:,2) = uslp (:,:,:) 
    230          vslpdta (:,:,:,2) = vslp (:,:,:) 
    231          wslpidta(:,:,:,2) = wslpi(:,:,:) 
    232          wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    233 #endif 
    234           
    235          ! swap from record 2 to 1 
    236          CALL swap_dyn_data 
    237           
     174            uslpdta (:,:,:,2) = uslp (:,:,:) 
     175            vslpdta (:,:,:,2) = vslp (:,:,:) 
     176            wslpidta(:,:,:,2) = wslpi(:,:,:) 
     177            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
     178         END IF 
     179         ! 
     180         CALL swap_dyn_data            ! swap from record 2 to 1 
     181         ! 
    238182         iswap = 1        !  indicates swap 
    239           
    240          CALL dynrea( kt, iper )    ! data read for the iper period 
    241           
    242 #if defined key_ldfslp 
    243          ! Computes slopes 
    244          ! Caution : here tn, sn and avt are used as workspace 
    245          tn (:,:,:) = tdta  (:,:,:,2) 
    246          sn (:,:,:) = sdta  (:,:,:,2) 
    247          avt(:,:,:) = avtdta(:,:,:,2) 
    248           
    249          CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
    250          CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
    251          IF( ln_zps )   & 
    252             &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
    253             &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
    254             &                 gtv, gsv, grv ) 
    255          CALL zdf_mxl( kt )              ! mixed layer depth 
    256          CALL ldf_slp( kt, rhd, rn2 ) 
    257           
    258          uslpdta (:,:,:,2) = uslp (:,:,:) 
    259          vslpdta (:,:,:,2) = vslp (:,:,:) 
    260          wslpidta(:,:,:,2) = wslpi(:,:,:) 
    261          wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    262 #endif 
    263          ! 
    264          lfirdyn=.FALSE.    ! trace the first call 
     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) 
     187            tsn (:,:,:,jp_tem) = tdta  (:,:,:,2) 
     188            tsn (:,:,:,jp_sal) = sdta  (:,:,:,2) 
     189            avt(:,:,:)         = avtdta(:,:,:,2) 
     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            ! 
     198            uslpdta (:,:,:,2) = uslp (:,:,:) 
     199            vslpdta (:,:,:,2) = vslp (:,:,:) 
     200            wslpidta(:,:,:,2) = wslpi(:,:,:) 
     201            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
     202         END IF 
     203         ! 
     204         lfirdyn = .FALSE.    ! trace the first call 
    265205      ENDIF 
    266206      ! 
     
    269209      ! 
    270210      IF( iperm1 /= ndyn1 ) THEN  
    271  
    272          IF( iperm1 == 0. ) THEN 
    273             IF (lwp) THEN 
     211         ! 
     212         IF( iperm1 == 0 ) THEN 
     213            IF(lwp) THEN 
    274214               WRITE (numout,*) ' dynamic file is not periodic with periodic interpolation' 
    275215               WRITE (numout,*) ' we take the last value for the last period ' 
     
    280220         ENDIF 
    281221         ! 
    282          ! We have to prepare a new read of data : swap from record 2 to 1 
    283          ! 
    284          CALL swap_dyn_data 
    285  
    286          iswap = 1        !  indicates swap 
    287           
     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         ! 
    288226         CALL dynrea( kt, iper )    ! data read for the iper period 
    289  
    290 #if defined key_ldfslp 
    291          ! Computes slopes 
    292          ! Caution : here tn, sn and avt are used as workspace 
    293          tn (:,:,:) = tdta  (:,:,:,2) 
    294          sn (:,:,:) = sdta  (:,:,:,2) 
    295          avt(:,:,:) = avtdta(:,:,:,2) 
    296           
    297          CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
    298          CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
    299          IF( ln_zps )   & 
    300             &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
    301             &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
    302             &                 gtv, gsv, grv ) 
    303          CALL zdf_mxl( kt )              ! mixed layer depth 
    304          CALL ldf_slp( kt, rhd, rn2 ) 
    305           
    306          uslpdta (:,:,:,2) = uslp (:,:,:) 
    307          vslpdta (:,:,:,2) = vslp (:,:,:) 
    308          wslpidta(:,:,:,2) = wslpi(:,:,:) 
    309          wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    310 #endif 
    311         
    312          ! store the information of the period read 
    313          ndyn1 = ndyn2 
     227         ! 
     228         IF( lk_ldfslp .AND. .NOT. lk_c1d ) THEN 
     229            ! Computes slopes. Caution : here tsn and avt are used as workspace 
     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            ! 
     241            uslpdta (:,:,:,2) = uslp (:,:,:) 
     242            vslpdta (:,:,:,2) = vslp (:,:,:) 
     243            wslpidta(:,:,:,2) = wslpi(:,:,:) 
     244            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
     245         END IF 
     246         ! 
     247         ndyn1 = ndyn2         ! store the information of the period read 
    314248         ndyn2 = iper 
    315  
    316          IF (lwp) THEN 
    317             WRITE (numout,*) ' dynamics data read for the period ndyn1 =',ndyn1, & 
    318                &             ' 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 
    319253            WRITE (numout,*) ' time step is : ', kt 
    320254         END IF 
     
    325259      !----------------------------------------      
    326260 
    327       IF( nsptint == 0 ) THEN    
    328          ! No spatial interpolation, data are probably correct 
    329          ! We have to initialize data if we have changed the period          
    330          CALL assign_dyn_data           
    331       ELSE IF( nsptint == 1 ) THEN 
    332          ! 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 
    333265         CALL linear_interp_dyn_data( zweigh ) 
    334       ELSE  
    335          ! other interpolation 
     266      ELSE                             ! other interpolation 
    336267         WRITE (numout,*) ' this kind of interpolation do not exist at the moment : we stop' 
    337268         STOP 'dtadyn'          
    338269      END IF 
    339        
    340       ! In any case, we need rhop 
    341       CALL eos( tn, sn, rhd, rhop )  
    342        
    343 #if ! defined key_off_degrad && defined key_traldf_c2d 
    344       ! In case of 2D varying coefficients, we need aeiv and aeiu 
    345       IF( lk_traldf_eiv )   CALL ldf_eiv( kt )      ! eddy induced velocity coefficient 
    346 #endif 
    347     
     270      ! 
     271      CALL eos( tsn, rhd, rhop )       ! In any case, we need rhop 
     272      ! 
     273#if ! defined key_degrad && defined key_traldf_c2d 
     274      !                                ! In case of 2D varying coefficients, we need aeiv and aeiu 
     275      IF( lk_traldf_eiv )   CALL dta_eiv( kt )      ! eddy induced velocity coefficient 
     276#endif 
     277      ! 
     278      IF( .NOT. l_offbbl ) THEN       ! Compute bbl coefficients if needed 
     279         tsb(:,:,:,:) = tsn(:,:,:,:) 
     280         CALL bbl( kt, 'TRC') 
     281      END IF 
     282      IF(ln_ctl) THEN 
     283         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     284         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     285         CALL prt_ctl(tab3d_1=un               , clinfo1=' un      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     286         CALL prt_ctl(tab3d_1=vn               , clinfo1=' vn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     287         CALL prt_ctl(tab3d_1=wn               , clinfo1=' wn      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     288         CALL prt_ctl(tab3d_1=avt              , clinfo1=' kz      - : ', mask1=tmask, ovlap=1, kdim=jpk   ) 
     289         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i    - : ', mask1=tmask, ovlap=1 ) 
     290         CALL prt_ctl(tab2d_1=hmld             , clinfo1=' hmld    - : ', mask1=tmask, ovlap=1 ) 
     291         CALL prt_ctl(tab2d_1=emps             , clinfo1=' emps    - : ', mask1=tmask, ovlap=1 ) 
     292         CALL prt_ctl(tab2d_1=wndm             , clinfo1=' wspd    - : ', mask1=tmask, ovlap=1 ) 
     293         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr     - : ', mask1=tmask, ovlap=1 ) 
     294      ENDIF 
     295      ! 
    348296   END SUBROUTINE dta_dyn 
     297 
    349298 
    350299   SUBROUTINE dynrea( kt, kenr ) 
     
    354303      !! ** Purpose : READ dynamics fiels from OPA9 netcdf output 
    355304      !!  
    356       !! ** Method : READ the kenr records of DATA and store in 
    357       !!             in udta(...,2), ....   
    358       !!  
    359       !! ** History : additions : M. Levy et M. Benjelloul jan 2001  
    360       !!              (netcdf FORMAT)  
    361       !!              05-03 (O. Aumont and A. El Moussaoui) F90 
    362       !!              06-07 : (C. Ethe) use of iom module 
    363       !!---------------------------------------------------------------------- 
    364       !! * Modules used 
    365       USE iom 
    366  
    367       !! * Arguments 
    368       INTEGER, INTENT( in ) ::   kt, kenr       ! time index 
    369       !! * Local declarations 
     305      !! ** Method : READ the kenr records of DATA and store in udta(...,2), ....   
     306      !!---------------------------------------------------------------------- 
     307      INTEGER, INTENT(in) ::   kt, kenr   ! time index 
     308      !! 
    370309      INTEGER ::  jkenr 
    371  
    372       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    373         zu, zv, zw, zt, zs, zavt ,   &     ! 3-D dynamical fields 
    374         zhdiv                              ! horizontal divergence 
    375  
    376       REAL(wp), DIMENSION(jpi,jpj) :: & 
    377          zemp, zqsr, zmld, zice, zwspd, & 
    378          ztaux, ztauy 
    379 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    380       REAL(wp), DIMENSION(jpi,jpj) :: zbblx, zbbly 
    381 #endif 
    382  
    383 #if ! defined key_off_degrad && defined key_traldf_c2d 
    384       REAL(wp), DIMENSION(jpi,jpj) :: zahtw  
    385 #   if defined key_trcldf_eiv 
     310      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zu, zv, zw, zt, zs, zavt , zhdiv              ! 3D workspace 
     311      REAL(wp), DIMENSION(jpi,jpj)     ::  zemp, zqsr, zmld, zice, zwspd, ztaux, ztauy   ! 2D workspace 
     312      REAL(wp), DIMENSION(jpi,jpj)     ::  zbblx, zbbly 
     313 
     314#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    386315      REAL(wp), DIMENSION(jpi,jpj) :: zaeiw  
    387 #  endif 
    388 #endif 
    389  
    390 #if defined key_off_degrad 
    391    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    392       zahtu, zahtv, zahtw  !  Lateral diffusivity 
    393 # if defined key_trcldf_eiv 
    394    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    395       zaeiu, zaeiv, zaeiw  ! G&M coefficient 
     316#endif 
     317#if defined key_degrad 
     318   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zahtu, zahtv, zahtw  !  Lateral diffusivity 
     319# if defined key_traldf_eiv 
     320   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zaeiu, zaeiv, zaeiw  ! G&M coefficient 
    396321# endif 
    397322#endif 
    398  
    399       !--------------------------------------------------------------- 
     323      !!---------------------------------------------------------------------- 
     324 
    400325      ! 0. Initialization 
    401326       
     
    407332      IF(lwp) THEN 
    408333         WRITE(numout,*) 
    409          WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr 
    410          WRITE(numout,*) ' ~~~~~~~' 
    411 #if defined key_off_degrad 
     334         WRITE(numout,*) 'Dynrea : read dynamical fields, kenr = ', jkenr 
     335         WRITE(numout,*) '~~~~~~~' 
     336#if defined key_degrad 
    412337         WRITE(numout,*) ' Degraded fields' 
    413338#endif 
     
    442367      CALL iom_get( numfl_u, jpdom_data, 'vozocrtx', zu   (:,:,:), jkenr ) 
    443368      CALL iom_get( numfl_v, jpdom_data, 'vomecrty', zv   (:,:,:), jkenr ) 
    444  
    445 #if defined key_trcbbl_dif || defined key_trcbbl_adv 
    446       IF( iom_varid( numfl_u, 'sobblcox', ldstop = .FALSE. ) > 0  .AND. & 
    447       &   iom_varid( numfl_v, 'sobblcoy', ldstop = .FALSE. ) > 0 ) THEN 
    448          CALL iom_get( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:), jkenr ) 
    449          CALL iom_get( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:), jkenr ) 
    450       ELSE 
    451          CALL bbl_sign( zt, zs, zbblx, zbbly )     
    452       ENDIF 
    453 #endif 
     369      IF( lk_trabbl .AND. .NOT. lk_c1d .AND. nn_bbl_ldf == 1 ) THEN 
     370         IF( iom_varid( numfl_u, 'sobblcox', ldstop = .FALSE. ) > 0  .AND. & 
     371         &   iom_varid( numfl_v, 'sobblcoy', ldstop = .FALSE. ) > 0 ) THEN 
     372             CALL iom_get( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:), jkenr ) 
     373             CALL iom_get( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:), jkenr ) 
     374             l_offbbl = .TRUE. 
     375         ENDIF 
     376      ENDIF 
    454377 
    455378      ! file grid-W 
     
    458381      CALL wzv( zu, zv, zw, zhdiv ) 
    459382 
    460 # if defined key_zdfddm 
    461       CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 
    462 #else 
    463       CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 
    464 #endif  
    465  
    466 #if ! defined key_off_degrad && defined key_traldf_c2d 
    467       CALL iom_get( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr ) 
    468 #  if   defined key_trcldf_eiv  
     383      IF( iom_varid( numfl_w, 'voddmavs', ldstop = .FALSE. ) > 0 ) THEN          ! avs exist: it is used 
     384         CALL iom_get( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 
     385      ELSE                                                                       ! no avs: use avt 
     386         CALL iom_get( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 
     387      ENDIF 
     388 
     389#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    469390      CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr ) 
    470 #  endif 
    471 #endif 
    472  
    473 #if defined key_off_degrad 
     391#endif 
     392 
     393#if defined key_degrad 
    474394      CALL iom_get( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr ) 
    475395      CALL iom_get( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr ) 
    476396      CALL iom_get( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr ) 
    477 #  if defined key_trcldf_eiv 
     397#  if defined key_traldf_eiv 
    478398      CALL iom_get( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr ) 
    479399      CALL iom_get( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr ) 
     
    486406      wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
    487407 
    488 #if defined key_trc_diatrd 
    489       hdivdta(:,:,:,2) = zhdiv(:,:,:) * tmask(:,:,:) 
    490 #endif 
    491  
    492408      tdta(:,:,:,2)   = zt  (:,:,:) * tmask(:,:,:) 
    493409      sdta(:,:,:,2)   = zs  (:,:,:) * tmask(:,:,:) 
    494410      avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 
    495411 
    496 #if ! defined key_off_degrad && defined key_traldf_c2d 
    497       ahtwdta(:,:,2)  = zahtw(:,:) * tmask(:,:,1) 
    498 #if defined key_trcldf_eiv 
     412#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    499413      aeiwdta(:,:,2)  = zaeiw(:,:) * tmask(:,:,1) 
    500414#endif 
    501 #endif 
    502  
    503 #if defined key_off_degrad 
     415 
     416#if defined key_degrad 
    504417        ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:) 
    505418        ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:) 
    506419        ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:) 
    507 #  if defined key_trcldf_eiv 
     420#  if defined key_traldf_eiv 
    508421        aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:) 
    509422        aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:) 
     
    519432      qsrdta (:,:,2)  = zqsr(:,:) * tmask(:,:,1) 
    520433      hmlddta(:,:,2)  = zmld(:,:) * tmask(:,:,1) 
    521        
    522 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    523       bblxdta(:,:,2) = MAX( 0., zbblx(:,:) ) 
    524       bblydta(:,:,2) = MAX( 0., zbbly(:,:) ) 
    525  
    526       WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0. 
    527       WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0. 
    528 #endif 
    529  
     434 
     435      IF( l_offbbl ) THEN  
     436         bblxdta(:,:,2) = MAX( 0., zbblx(:,:) ) 
     437         bblydta(:,:,2) = MAX( 0., zbbly(:,:) ) 
     438         WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0. 
     439         WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0. 
     440      ENDIF 
     441       
    530442      IF( kt == nitend ) THEN 
    531443         CALL iom_close ( numfl_t ) 
     
    534446         CALL iom_close ( numfl_w ) 
    535447      ENDIF 
    536        
     448      !       
    537449   END SUBROUTINE dynrea 
    538450 
     451 
    539452   SUBROUTINE dta_dyn_init 
    540453      !!---------------------------------------------------------------------- 
     
    544457      !! 
    545458      !! ** Method : 
    546       !! 
    547       !! History : 
    548       !!    ! original  : 92-01 (M. Imbard: sub domain) 
    549       !!    ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.) 
    550       !!    ! 98-05 (L. Bopp read output of coupled run) 
    551       !!    ! 05-03 (O. Aumont and A. El Moussaoui) F90 
    552       !!---------------------------------------------------------------------- 
    553       !! * Modules used 
    554  
    555       !! * Local declarations 
    556  
     459      !!---------------------------------------------------------------------- 
    557460      REAL(wp) ::   znspyr   !: number of time step per year 
    558  
    559       NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, nficdyn, lperdyn,  & 
     461      !! 
     462      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  & 
    560463      &                cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
    561464      !!---------------------------------------------------------------------- 
     
    564467      ! ====================================== 
    565468 
    566       ! Read Namelist namdyn : Lateral physics on tracers 
    567       REWIND( numnam ) 
     469      REWIND( numnam )              ! Read Namelist namdyn : Lateral physics on tracers 
    568470      READ  ( numnam, namdyn ) 
    569471 
    570       IF(lwp) THEN 
     472      IF(lwp) THEN                  ! control print 
    571473         WRITE(numout,*) 
    572474         WRITE(numout,*) 'namdyn : offline dynamical selection' 
     
    577479         WRITE(numout,*) ' total number of elements in the FILE       ndtatot = ' , ndtatot 
    578480         WRITE(numout,*) ' type of interpolation                      nsptint = ' , nsptint 
    579          WRITE(numout,*) ' number of dynamics FILE                    nficdyn = ' , nficdyn 
    580481         WRITE(numout,*) ' loop on the same FILE                      lperdyn = ' , lperdyn 
    581482         WRITE(numout,*) '  ' 
     
    586487         WRITE(numout,*) ' ' 
    587488      ENDIF 
    588  
     489      ! 
    589490      znspyr   = nyear_len(1) * rday / rdt   
    590491      rnspdta  = znspyr / FLOAT( ndtadyn ) 
    591492      rnspdta2 = rnspdta * 0.5  
    592  
     493      ! 
     494      CALL dta_dyn( nit000 ) 
     495      ! 
    593496   END SUBROUTINE dta_dyn_init 
    594497 
     498 
    595499   SUBROUTINE wzv( pu, pv, pw, phdiv ) 
    596500      !!---------------------------------------------------------------------- 
     
    599503      !! ** Purpose :   Compute the now vertical velocity after the array swap 
    600504      !! 
    601       !! ** Method  : 
    602       !! ** Method  : - Divergence: 
    603       !!      - compute the now divergence given by : 
    604       !!         * z-coordinate 
     505      !! ** Method  : - compute the now divergence given by : 
     506      !!         * z-coordinate ONLY !!!! 
    605507      !!         hdiv = 1/(e1t*e2t) [ di(e2u  u) + dj(e1v  v) ] 
    606508      !!     - Using the incompressibility hypothesis, the vertical 
    607509      !!      velocity is computed by integrating the horizontal divergence 
    608510      !!      from the bottom to the surface. 
    609       !!        The boundary conditions are w=0 at the bottom (no flux) and, 
    610       !!      in regid-lid case, w=0 at the sea surface. 
    611       !! 
    612       !! 
    613       !! History : 
    614       !!   9.0  !  02-07  (G. Madec)  Vector optimization 
    615       !!---------------------------------------------------------------------- 
    616       !! * Arguments 
    617       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  )   :: pu, pv    !:  horizontal velocities 
    618       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out )   :: pw        !:  verticla velocity 
    619       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: phdiv     !:  horizontal divergence 
    620  
    621       !! * Local declarations 
     511      !!        The boundary conditions are w=0 at the bottom (no flux). 
     512      !!---------------------------------------------------------------------- 
     513      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) :: pu, pv    !:  horizontal velocities 
     514      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(  out) :: pw        !:  verticla velocity 
     515      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phdiv     !:  horizontal divergence 
     516      !! 
    622517      INTEGER  ::  ji, jj, jk 
    623518      REAL(wp) ::  zu, zu1, zv, zv1, zet 
    624  
    625  
     519      !!---------------------------------------------------------------------- 
     520      ! 
    626521      ! Computation of vertical velocity using horizontal divergence 
    627522      phdiv(:,:,:) = 0. 
     
    629524         DO jj = 2, jpjm1 
    630525            DO ji = fs_2, fs_jpim1   ! vector opt. 
    631 #if defined key_zco 
    632                zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) 
    633                zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) 
    634                zv  = pv(ji  ,jj  ,jk) * vmask(ji  ,jj  ,jk) * e1v(ji  ,jj  ) 
    635                zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) 
    636                zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) ) 
    637 #else 
    638526               zu  = pu(ji  ,jj  ,jk) * umask(ji  ,jj  ,jk) * e2u(ji  ,jj  ) * fse3u(ji  ,jj  ,jk) 
    639527               zu1 = pu(ji-1,jj  ,jk) * umask(ji-1,jj  ,jk) * e2u(ji-1,jj  ) * fse3u(ji-1,jj  ,jk) 
     
    641529               zv1 = pv(ji  ,jj-1,jk) * vmask(ji  ,jj-1,jk) * e1v(ji  ,jj-1) * fse3v(ji  ,jj-1,jk) 
    642530               zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 
    643 #endif 
    644531               phdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet  
    645532            END DO 
    646533         END DO 
    647       ENDDO 
    648  
    649       ! Lateral boundary conditions on phdiv 
    650       CALL lbc_lnk( phdiv, 'T', 1. ) 
    651  
    652  
     534      END DO 
     535      CALL lbc_lnk( phdiv, 'T', 1. )      ! Lateral boundary conditions on phdiv 
     536      ! 
    653537      ! computation of vertical velocity from the bottom 
    654       pw(:,:,jpk) = 0. 
     538      pw(:,:,jpk) = 0._wp 
    655539      DO jk = jpkm1, 1, -1 
    656540         pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * phdiv(:,:,jk) 
    657541      END DO 
    658  
     542      ! 
    659543   END SUBROUTINE wzv 
     544 
     545 
     546   SUBROUTINE dta_eiv( kt ) 
     547      !!---------------------------------------------------------------------- 
     548      !!                  ***  ROUTINE dta_eiv  *** 
     549      !! 
     550      !! ** Purpose :   Compute the eddy induced velocity coefficient from the 
     551      !!      growth rate of baroclinic instability. 
     552      !! 
     553      !! ** Method : Specific to the offline model. Computes the horizontal 
     554      !!             values from the vertical value 
     555      !!---------------------------------------------------------------------- 
     556      INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx 
     557      !! 
     558      INTEGER ::   ji, jj           ! dummy loop indices 
     559      !!---------------------------------------------------------------------- 
     560      ! 
     561      IF( kt == nit000 ) THEN 
     562         IF(lwp) WRITE(numout,*) 
     563         IF(lwp) WRITE(numout,*) 'dta_eiv : eddy induced velocity coefficients' 
     564         IF(lwp) WRITE(numout,*) '~~~~~~~' 
     565      ENDIF 
     566      ! 
     567      ! Average the diffusive coefficient at u- v- points 
     568      DO jj = 2, jpjm1 
     569         DO ji = fs_2, fs_jpim1   ! vector opt. 
     570            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) ) 
     571            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) ) 
     572         END DO 
     573      END DO 
     574      CALL lbc_lnk( aeiu, 'U', 1. )   ;   CALL lbc_lnk( aeiv, 'V', 1. )    ! lateral boundary condition 
     575      ! 
     576   END SUBROUTINE dta_eiv 
     577 
    660578 
    661579   SUBROUTINE tau2wnd( ptaux, ptauy, pwspd ) 
     
    667585      !! ** Method  : |tau|=rhoa*Cd*|U|^2 
    668586      !!--------------------------------------------------------------------- 
    669       !! * Arguments 
    670       REAL(wp), DIMENSION(jpi,jpj), INTENT( in  ) ::  & 
    671          ptaux, ptauy                              !: wind stress in i-j direction resp. 
    672       REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::  & 
    673          pwspd                                     !: wind speed  
    674       REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3 
    675       REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    676       REAL(wp) ::   ztx, zty, ztau, zcoef ! temporary variables 
    677       INTEGER  ::   ji, jj                ! dummy indices 
     587      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) ::   ptaux, ptauy   ! wind stress in i-j direction resp. 
     588      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pwspd          ! wind speed 
     589      !!  
     590      REAL(wp) ::   zrhoa  = 1.22_wp       ! Air density kg/m3 
     591      REAL(wp) ::   zcdrag = 1.5e-3_wp     ! drag coefficient 
     592      REAL(wp) ::   ztx, zty, ztau, zcoef  ! temporary variables 
     593      INTEGER  ::   ji, jj                 ! dummy indices 
    678594      !!--------------------------------------------------------------------- 
    679595      zcoef = 1. / ( zrhoa * zcdrag ) 
     
    689605      END DO 
    690606      CALL lbc_lnk( pwspd(:,:), 'T', 1. ) 
    691  
     607      ! 
    692608   END SUBROUTINE tau2wnd 
    693609 
    694 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    695  
    696    SUBROUTINE bbl_sign( ptn, psn, pbblx, pbbly ) 
    697       !!---------------------------------------------------------------------- 
    698       !!                    ***  ROUTINE bbl_sign  *** 
    699       !! 
    700       !! ** Purpose :   Compute the sign of local gradient of density multiplied by the slope 
    701       !!                along the bottom slope gradient : grad( rho) * grad(h) 
    702       !!                Need to compute the diffusive bottom boundary layer 
    703       !! 
    704       !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad 
    705       !!      is an along bottom slope gradient) an additional lateral diffu- 
    706       !!      sive trend along the bottom slope is added to the general tracer 
    707       !!      trend, otherwise nothing is done. See trcbbl.F90 
    708       !! 
    709       !! 
    710       !! History : 
    711       !!   9.0  !  02-07  (G. Madec)  Vector optimization 
    712       !!---------------------------------------------------------------------- 
    713       !! * Arguments 
    714       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  ) ::  & 
    715          ptn             ,  &                           !: temperature  
    716          psn                                            !: salinity  
    717       REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::  & 
    718          pbblx , pbbly                                  !: sign of bbl in i-j direction resp.  
    719        
    720       !! * Local declarations 
    721       INTEGER  ::   ji, jj                   ! dummy loop indices 
    722       INTEGER  ::   ik 
    723       REAL(wp) ::   & 
    724          ztx, zsx, zhx, zalbetx, zgdrhox,     &  ! temporary scalars 
    725          zty, zsy, zhy, zalbety, zgdrhoy  
    726       REAL(wp), DIMENSION(jpi,jpj) ::    & 
    727         ztnb, zsnb, zdep 
    728       REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function 
    729       !!---------------------------------------------------------------------- 
    730       ! ratio alpha/beta 
    731       ! ================ 
    732       !  fsalbt: ratio of thermal over saline expension coefficients 
    733       !       pft :  potential temperature in degrees celcius 
    734       !       pfs :  salinity anomaly (s-35) in psu 
    735       !       pfh :  depth in meters 
    736  
    737       fsalbt( pft, pfs, pfh ) =                                              & 
    738          ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    & 
    739                                    - 0.203814e-03 ) * pft                    & 
    740                                    + 0.170907e-01 ) * pft                    & 
    741                                    + 0.665157e-01                            & 
    742          +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   & 
    743          +  ( ( - 0.302285e-13 * pfh                                         & 
    744                 - 0.251520e-11 * pfs                                         & 
    745                 + 0.512857e-12 * pft * pft          ) * pfh                  & 
    746                                      - 0.164759e-06   * pfs                  & 
    747              +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  & 
    748                                      + 0.380374e-04 ) * pfh 
    749  
    750       ! 0. 2D fields of bottom temperature and salinity, and bottom slope 
    751       ! ----------------------------------------------------------------- 
    752       ! mbathy= number of w-level, minimum value=1 (cf domrea.F90) 
    753 #  if defined key_vectopt_loop 
    754       jj = 1 
    755       DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    756 #  else 
    757       DO jj = 1, jpj 
    758          DO ji = 1, jpi 
    759 #  endif 
    760             ik          =  MAX( mbathy(ji,jj) - 1, 1 )    ! vertical index of the bottom ocean T-level 
    761             ztnb(ji,jj) = ptn(ji,jj,ik) * tmask(ji,jj,1)  ! masked T and S at ocean bottom 
    762             zsnb(ji,jj) = psn(ji,jj,ik) * tmask(ji,jj,1) 
    763             zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level 
    764 #  if ! defined key_vectopt_loop 
    765          END DO 
    766 #  endif 
    767       END DO 
    768  
    769       !!---------------------------------------------------------------------- 
    770       ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0 
    771       ! -------------------------------------------- 
    772       ! Sign of the local density gradient along the i- and j-slopes 
    773       ! multiplied by the slope of the ocean bottom 
    774  
    775       SELECT CASE ( neos ) 
    776  
    777       CASE ( 0 )                 ! Jackett and McDougall (1994) formulation 
    778  
    779 #  if defined key_vectopt_loop 
    780       jj = 1 
    781       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    782 #  else 
    783       DO jj = 1, jpjm1 
    784          DO ji = 1, jpim1 
    785 #  endif 
    786             ! temperature, salinity anomalie and depth 
    787             ztx = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
    788             zsx = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
    789             zhx = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    790             ! 
    791             zty = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
    792             zsy = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
    793             zhy = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    794             ! masked ratio alpha/beta 
    795             zalbetx = fsalbt( ztx, zsx, zhx ) * umask(ji,jj,1) 
    796             zalbety = fsalbt( zty, zsy, zhy ) * vmask(ji,jj,1) 
    797             ! local density gradient along i-bathymetric slope 
    798             zgdrhox = zalbetx * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
    799                    -            ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
    800             ! local density gradient along j-bathymetric slope 
    801             zgdrhoy = zalbety * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    802                    -            ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    803             ! sign of local i-gradient of density multiplied by the i-slope 
    804             pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    805             ! sign of local j-gradient of density multiplied by the j-slope 
    806             pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    807 #  if ! defined key_vectopt_loop 
    808          END DO 
    809 #  endif 
    810       END DO 
    811  
    812       CASE ( 1 )               ! Linear formulation function of temperature only 
    813                                ! 
    814 #  if defined key_vectopt_loop 
    815       jj = 1 
    816       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    817 #  else 
    818       DO jj = 1, jpjm1 
    819          DO ji = 1, jpim1 
    820 #  endif 
    821             ! local 'density/temperature' gradient along i-bathymetric slope 
    822             zgdrhox =  ztnb(ji+1,jj) - ztnb(ji,jj) 
    823             ! local density gradient along j-bathymetric slope 
    824             zgdrhoy =  ztnb(ji,jj+1) - ztnb(ji,jj) 
    825             ! sign of local i-gradient of density multiplied by the i-slope 
    826             pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    827             ! sign of local j-gradient of density multiplied by the j-slope 
    828             pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    829 #  if ! defined key_vectopt_loop 
    830          END DO 
    831 #  endif 
    832       END DO 
    833  
    834       CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    835  
    836 #  if defined key_vectopt_loop 
    837       jj = 1 
    838       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    839 #  else 
    840       DO jj = 1, jpjm1 
    841          DO ji = 1, jpim1 
    842 #  endif      
    843             ! local density gradient along i-bathymetric slope 
    844             zgdrhox = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
    845                       -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
    846             ! local density gradient along j-bathymetric slope 
    847             zgdrhoy = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
    848                       -  ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 
    849             ! sign of local i-gradient of density multiplied by the i-slope 
    850             pbblx(ji,jj) = 0.5 - SIGN( 0.5, - zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    851             ! sign of local j-gradient of density multiplied by the j-slope 
    852             pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    853 #  if ! defined key_vectopt_loop 
    854          END DO 
    855 #  endif 
    856       END DO 
    857  
    858       CASE DEFAULT 
    859  
    860          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    861          CALL ctl_stop(ctmp1) 
    862  
    863       END SELECT 
    864     
    865       ! Lateral boundary conditions 
    866       CALL lbc_lnk( pbblx, 'U', 1. ) 
    867       CALL lbc_lnk( pbbly, 'V', 1. ) 
    868  
    869    END SUBROUTINE bbl_sign 
    870  
    871 #endif 
    872610 
    873611   SUBROUTINE swap_dyn_data 
     
    876614      !! 
    877615      !! ** Purpose :   swap array data 
    878       !! 
    879       !! History : 
    880       !!   9.0  !  07-09  (C. Ethe) 
    881       !!---------------------------------------------------------------------- 
    882  
    883  
     616      !!---------------------------------------------------------------------- 
     617      ! 
    884618      ! swap from record 2 to 1 
    885619      tdta   (:,:,:,1) = tdta   (:,:,:,2) 
     
    889623      vdta   (:,:,:,1) = vdta   (:,:,:,2) 
    890624      wdta   (:,:,:,1) = wdta   (:,:,:,2) 
    891 #if defined key_trc_diatrd 
    892       hdivdta(:,:,:,1) = hdivdta(:,:,:,2) 
    893 #endif 
    894  
    895 #if defined key_ldfslp 
     625#if defined key_ldfslp && ! defined key_c1d 
    896626      uslpdta (:,:,:,1) = uslpdta (:,:,:,2) 
    897627      vslpdta (:,:,:,1) = vslpdta (:,:,:,2) 
     
    904634      empdta (:,:,1) = empdta (:,:,2)  
    905635      qsrdta (:,:,1) = qsrdta (:,:,2)  
    906  
    907 #if ! defined key_off_degrad && defined key_traldf_c2d 
    908       ahtwdta(:,:,1) = ahtwdta(:,:,2) 
    909 #  if defined key_trcldf_eiv 
     636      IF( l_offbbl ) THEN 
     637         bblxdta(:,:,1) = bblxdta(:,:,2) 
     638         bblydta(:,:,1) = bblydta(:,:,2)  
     639      ENDIF 
     640 
     641#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    910642      aeiwdta(:,:,1) = aeiwdta(:,:,2) 
    911 #  endif 
    912 #endif 
    913  
    914 #if defined key_off_degrad 
     643#endif 
     644 
     645#if defined key_degrad 
    915646      ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 
    916647      ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 
    917648      ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 
    918 #  if defined key_trcldf_eiv 
     649#  if defined key_traldf_eiv 
    919650      aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 
    920651      aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 
     
    922653#  endif 
    923654#endif 
    924  
    925 #if defined key_trcbbl_dif || defined key_trcbbl_adv 
    926       bblxdta(:,:,1) = bblxdta(:,:,2) 
    927       bblydta(:,:,1) = bblydta(:,:,2) 
    928 #endif 
    929  
     655      ! 
    930656   END SUBROUTINE swap_dyn_data 
     657 
    931658 
    932659   SUBROUTINE assign_dyn_data 
     
    939666      !!---------------------------------------------------------------------- 
    940667       
    941       tn (:,:,:) = tdta  (:,:,:,2) 
    942       sn (:,:,:) = sdta  (:,:,:,2) 
    943       avt(:,:,:) = avtdta(:,:,:,2) 
     668      tsn(:,:,:,jp_tem) = tdta  (:,:,:,2) 
     669      tsn(:,:,:,jp_sal) = sdta  (:,:,:,2) 
     670      avt(:,:,:)        = avtdta(:,:,:,2) 
    944671       
    945672      un (:,:,:) = udta  (:,:,:,2)  
    946673      vn (:,:,:) = vdta  (:,:,:,2) 
    947674      wn (:,:,:) = wdta  (:,:,:,2) 
    948  
    949 #if defined key_trc_diatrd 
    950       hdivn(:,:,:) = hdivdta(:,:,:,2) 
    951 #endif 
    952  
    953 #if defined key_zdfddm 
    954       avs(:,:,:)   = avtdta (:,:,:,2) 
    955 #endif 
    956  
    957        
    958 #if defined key_ldfslp 
     675       
     676#if defined key_ldfslp && ! defined key_c1d 
    959677      uslp (:,:,:) = uslpdta (:,:,:,2)  
    960678      vslp (:,:,:) = vslpdta (:,:,:,2)  
     
    969687      emps(:,:) = emp(:,:)  
    970688      qsr (:,:) = qsrdta (:,:,2)  
    971  
    972 #if ! defined key_off_degrad && defined key_traldf_c2d     
    973       ahtw(:,:) = ahtwdta(:,:,2) 
    974 #  if defined key_trcldf_eiv 
     689      IF( l_offbbl ) THEN 
     690         ahu_bbl(:,:) = bblxdta(:,:,2) 
     691         ahv_bbl(:,:) = bblydta(:,:,2)  
     692      ENDIF 
     693#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    975694      aeiw(:,:) = aeiwdta(:,:,2) 
    976 #  endif 
    977 #endif 
    978        
    979 #if defined key_off_degrad 
     695#endif 
     696       
     697#if defined key_degrad 
    980698      ahtu(:,:,:) = ahtudta(:,:,:,2) 
    981699      ahtv(:,:,:) = ahtvdta(:,:,:,2) 
    982700      ahtw(:,:,:) = ahtwdta(:,:,:,2) 
    983 #  if defined key_trcldf_eiv 
     701#  if defined key_traldf_eiv 
    984702      aeiu(:,:,:) = aeiudta(:,:,:,2) 
    985703      aeiv(:,:,:) = aeivdta(:,:,:,2) 
    986704      aeiw(:,:,:) = aeiwdta(:,:,:,2) 
    987705#  endif 
    988        
    989 #endif 
    990        
    991 #if defined key_trcbbl_dif ||  defined key_trcbbl_adv 
    992       bblx(:,:) = bblxdta(:,:,2) 
    993       bbly(:,:) = bblydta(:,:,2) 
    994 #endif 
    995  
     706#endif 
     707      ! 
    996708   END SUBROUTINE assign_dyn_data 
    997709 
     710 
    998711   SUBROUTINE linear_interp_dyn_data( pweigh ) 
    999712      !!---------------------------------------------------------------------- 
    1000       !!                    ***  ROUTINE linear_interp_dyn_data  *** 
     713      !!               ***  ROUTINE linear_interp_dyn_data  *** 
    1001714      !! 
    1002715      !! ** Purpose :   linear interpolation of data 
    1003       !! 
    1004       !!---------------------------------------------------------------------- 
    1005       !! * Argument 
    1006       REAL(wp), INTENT( in ) ::   pweigh       ! weigh 
    1007  
    1008       !! * Local declarations 
     716      !!---------------------------------------------------------------------- 
     717      REAL(wp), INTENT(in) ::   pweigh   ! weigh 
     718      !! 
    1009719      REAL(wp) :: zweighm1 
    1010720      !!---------------------------------------------------------------------- 
     
    1012722      zweighm1 = 1. - pweigh 
    1013723       
    1014       tn (:,:,:) = zweighm1 * tdta  (:,:,:,1) + pweigh * tdta  (:,:,:,2) 
    1015       sn (:,:,:) = zweighm1 * sdta  (:,:,:,1) + pweigh * sdta  (:,:,:,2) 
    1016       avt(:,:,:) = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2) 
     724      tsn(:,:,:,jp_tem) = zweighm1 * tdta  (:,:,:,1) + pweigh * tdta  (:,:,:,2) 
     725      tsn(:,:,:,jp_sal) = zweighm1 * sdta  (:,:,:,1) + pweigh * sdta  (:,:,:,2) 
     726      avt(:,:,:)        = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2) 
    1017727       
    1018728      un (:,:,:) = zweighm1 * udta  (:,:,:,1) + pweigh * udta  (:,:,:,2)  
    1019729      vn (:,:,:) = zweighm1 * vdta  (:,:,:,1) + pweigh * vdta  (:,:,:,2) 
    1020730      wn (:,:,:) = zweighm1 * wdta  (:,:,:,1) + pweigh * wdta  (:,:,:,2) 
    1021  
    1022 #if defined key_trc_diatrd 
    1023       hdivn(:,:,:) = zweighm1 * hdivdta(:,:,:,1) + pweigh * hdivdta(:,:,:,2) 
    1024 #endif 
    1025  
    1026 #if defined key_zdfddm 
    1027       avs(:,:,:)   = zweighm1 * avtdta (:,:,:,1) + pweigh * avtdta (:,:,:,2) 
    1028 #endif 
    1029  
    1030        
    1031 #if defined key_ldfslp 
     731       
     732#if defined key_ldfslp && ! defined key_c1d 
    1032733      uslp (:,:,:) = zweighm1 * uslpdta (:,:,:,1) + pweigh * uslpdta (:,:,:,2)  
    1033734      vslp (:,:,:) = zweighm1 * vslpdta (:,:,:,1) + pweigh * vslpdta (:,:,:,2)  
     
    1042743      emps(:,:) = emp(:,:)  
    1043744      qsr (:,:) = zweighm1 * qsrdta (:,:,1) + pweigh  * qsrdta (:,:,2)  
    1044  
    1045 #if ! defined key_off_degrad && defined key_traldf_c2d     
    1046       ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + pweigh * ahtwdta(:,:,2) 
    1047 #  if defined key_trcldf_eiv 
     745      IF( l_offbbl ) THEN 
     746         ahu_bbl(:,:) = zweighm1 * bblxdta(:,:,1) +  pweigh  * bblxdta(:,:,2) 
     747         ahv_bbl(:,:) = zweighm1 * bblydta(:,:,1) +  pweigh  * bblydta(:,:,2) 
     748      ENDIF 
     749 
     750#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    1048751      aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + pweigh * aeiwdta(:,:,2) 
    1049 #  endif 
    1050 #endif 
    1051        
    1052 #if defined key_off_degrad 
     752#endif 
     753       
     754#if defined key_degrad 
    1053755      ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + pweigh * ahtudta(:,:,:,2) 
    1054756      ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + pweigh * ahtvdta(:,:,:,2) 
    1055757      ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + pweigh * ahtwdta(:,:,:,2) 
    1056 #  if defined key_trcldf_eiv 
     758#  if defined key_traldf_eiv 
    1057759      aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + pweigh * aeiudta(:,:,:,2) 
    1058760      aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + pweigh * aeivdta(:,:,:,2) 
     
    1060762#  endif 
    1061763#endif 
    1062        
    1063 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    1064       bblx(:,:) = zweighm1 * bblxdta(:,:,1) + pweigh * bblxdta(:,:,2) 
    1065       bbly(:,:) = zweighm1 * bblydta(:,:,1) + pweigh * bblydta(:,:,2) 
    1066 #endif 
    1067  
     764      !       
    1068765   END SUBROUTINE linear_interp_dyn_data 
    1069766 
     767   !!====================================================================== 
    1070768END MODULE dtadyn 
  • trunk/NEMOGCM/NEMO/OFF_SRC/istate.F90

    • Property svn:eol-style deleted
    r1715 r2528  
    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 
     
    2622#  include "vectopt_loop_substitute.h90" 
    2723   !!---------------------------------------------------------------------- 
    28    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    29    !!   $Id$ 
    30    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    31    !!---------------------------------------------------------------------- 
    32  
     24   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     25   !! $Id$ 
     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       ;   tn   (:,:,:) = 0.e0   ;   ta   (:,:,:) = 0.e0 
    62       ;   sn   (:,:,:) = 0.e0   ;   sa   (:,:,:) = 0.e0 
    63  
     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      ! 
    6444      rhd  (:,:,:) = 0.e0 
    6545      rhop (:,:,:) = 0.e0 
    6646      rn2  (:,:,:) = 0.e0  
    67  
    68  
     47      ! 
    6948   END SUBROUTINE istate_init 
    7049 
  • trunk/NEMOGCM/NEMO/OFF_SRC/opa.F90

    • Property svn:eol-style deleted
    r1749 r2528  
    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 
    23    USE ldftra          ! lateral diffusivity setting    (ldftra_init routine) 
    24    USE traqsr          ! solar radiation penetration   (tra_qsr_init routine) 
    25  
     22   !              ! ocean physics 
     23   USE ldftra          ! lateral diffusivity setting    (ldf_tra_init routine) 
     24   USE ldfslp          ! slopes of neutral surfaces     (ldf_slp_init routine) 
     25   USE traqsr          ! solar radiation penetration    (tra_qsr_init routine) 
     26   USE trabbl          ! bottom boundary layer          (tra_bbl_init routine) 
     27   USE zdfini          ! vertical physics: initialization 
    2628   USE phycst          ! physical constant                  (par_cst routine) 
    2729   USE dtadyn          ! Lecture and Interpolation of the dynamical fields 
    2830   USE trcini          ! Initilization of the passive tracers 
    29    USE step            ! OPA time-stepping                  (stp     routine) 
    30  
    31    USE iom 
     31   USE daymod          ! calendar                         (day     routine) 
     32   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
     33   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
     34   USE stpctl          ! time stepping control            (stp_ctl routine) 
     35   !              ! I/O & MPP 
     36   USE iom             ! I/O library 
     37   USE in_out_manager  ! I/O manager 
     38   USE mppini          ! shared/distributed memory setting (mpp_init routine) 
     39   USE lib_mpp         ! distributed memory computing 
    3240#if defined key_iomput 
    3341   USE  mod_ioclient 
     
    3644   IMPLICIT NONE 
    3745   PRIVATE 
    38  
    39    !! * Module variables 
    40    CHARACTER (len=64) ::        & 
    41       cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    42  
    43    !! * Routine accessibility 
    44    PUBLIC opa_model      ! called by model.F90 
    45    PUBLIC opa_init 
    46    !!---------------------------------------------------------------------- 
    47    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    48    !!   $Id$ 
    49    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    50    !!---------------------------------------------------------------------- 
    51  
     46    
     47   PUBLIC   opa_model   ! called by model.F90 
     48 
     49   CHARACTER (len=64) ::   cform_aaa="( /, 'AAAAAAAA', / ) "   ! flag for output listing 
     50 
     51   !!---------------------------------------------------------------------- 
     52   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     53   !! $Id$ 
     54   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     55   !!---------------------------------------------------------------------- 
    5256CONTAINS 
    5357 
     
    6064      !! 
    6165      !! ** Method  : - model general initialization 
    62       !!              - launch the time-stepping (stp routine) 
    63       !! 
    64       !! References : 
    65       !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 
    66       !!              internal report, IPSL. 
    67       !!---------------------------------------------------------------------- 
    68       INTEGER ::   istp       ! time step index 
     66      !!              - launch the time-stepping (dta_dyn and trc_stp) 
     67      !!              - finalize the run by closing files and communications 
     68      !! 
     69      !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL. 
     70      !!              Madec, 2008, internal report, IPSL. 
     71      !!---------------------------------------------------------------------- 
     72      INTEGER :: istp, indic       ! time step index 
    6973      !!---------------------------------------------------------------------- 
    7074 
     
    7781      IF( lk_mpp )   CALL mpp_max( nstop ) 
    7882 
     83      !                            !-----------------------! 
     84      !                            !==   time stepping   ==! 
     85      !                            !-----------------------! 
    7986      istp = nit000 
    8087         ! 
    81       DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    82          CALL stp( istp ) 
     88      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
     89         ! 
     90         IF( istp /= nit000 )   CALL day      ( istp )         ! Calendar (day was already called at nit000 in day_init) 
     91                                CALL iom_setkt( istp )         ! say to iom that we are at time step kstp 
     92                                CALL dta_dyn  ( istp )         ! Interpolation of the dynamical fields 
     93                                CALL trc_stp  ( istp )         ! time-stepping 
     94                                CALL stp_ctl  ( istp, indic )  ! Time loop: control and print 
    8395         istp = istp + 1 
    8496         IF( lk_mpp )   CALL mpp_max( nstop ) 
    8597      END DO 
    86       !                                     ! ========= ! 
    87       !                                     !  Job end  ! 
    88       !                                     ! ========= ! 
    89  
    90       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     98 
     99      !                            !------------------------! 
     100      !                            !==  finalize the run  ==! 
     101      !                            !------------------------! 
     102      IF(lwp) WRITE(numout,cform_aaa)                 ! Flag AAAAAAA 
    91103 
    92104      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print 
     
    94106         WRITE(numout,*) nstop, ' error have been found' 
    95107      ENDIF 
    96  
     108      ! 
    97109      CALL opa_closefile 
    98  
     110      ! 
    99111      IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp) 
    100112      ! 
     
    106118      !!                     ***  ROUTINE opa_init *** 
    107119      !! 
    108       !! ** Purpose :   opa solves the primitive equations on an orthogonal  
    109       !!      curvilinear mesh on the sphere. 
    110       !! 
    111       !! ** Method  : - model general initialization 
    112       !! 
    113       !! References : 
    114       !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 
    115       !!              internal report, IPSL. 
    116       !! 
    117       !! History : 
    118       !!   4.0  !  90-10  (C. Levy, G. Madec)  Original code 
    119       !!   7.0  !  91-11  (M. Imbard, C. Levy, G. Madec) 
    120       !!   7.1  !  93-03  (M. Imbard, C. Levy, G. Madec, O. Marti, 
    121       !!                   M. Guyon, A. Lazar, P. Delecluse, C. Perigaud, 
    122       !!                   G. Caniaux, B. Colot, C. Maes ) release 7.1  
    123       !!        !  92-06  (L.Terray) coupling implementation 
    124       !!        !  93-11  (M.A. Filiberti) IGLOO sea-ice  
    125       !!   8.0  !  96-03  (M. Imbard, C. Levy, G. Madec, O. Marti, 
    126       !!                   M. Guyon, A. Lazar, P. Delecluse, L.Terray, 
    127       !!                   M.A. Filiberti, J. Vialar, A.M. Treguier, 
    128       !!                   M. Levy)  release 8.0 
    129       !!   8.1  !  97-06  (M. Imbard, G. Madec) 
    130       !!   8.2  !  99-11  (M. Imbard, H. Goosse)  LIM sea-ice model  
    131       !!        !  99-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP  
    132       !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
    133       !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules 
    134       !!---------------------------------------------------------------------- 
    135       !! * Local declarations 
     120      !! ** Purpose :   initialization of the opa model in off-line mode 
     121      !!---------------------------------------------------------------------- 
     122      INTEGER ::   ji            ! dummy loop indices 
     123      INTEGER ::   ilocal_comm   ! local integer 
     124      CHARACTER(len=80), DIMENSION(10) ::   cltxt = '' 
     125      !! 
     126      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
     127         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 
     128      !!---------------------------------------------------------------------- 
     129      ! 
     130      !                             ! open Namelist file      
     131      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     132      ! 
     133      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark 
     134      ! 
     135      !                             !--------------------------------------------! 
     136      !                             !  set communicator & select the local node  ! 
     137      !                             !--------------------------------------------! 
    136138#if defined key_iomput 
    137       INTEGER :: localComm 
     139      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
     140      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
     141#else 
     142      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt) 
    138143#endif 
    139       CHARACTER (len=20) ::   namelistname 
    140       CHARACTER (len=28) ::   file_out 
    141       NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   & 
    142          &             isplt , jsplt , njctls, njctle, nbench 
    143  
    144       !!---------------------------------------------------------------------- 
    145  
    146       ! Initializations 
    147       ! =============== 
    148  
    149       file_out = 'ocean.output' 
    150  
    151       ! open listing and namelist units 
    152       CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   & 
    153          &         'SEQUENTIAL', 1, 6, .FALSE., 1 ) 
    154  
    155       namelistname = 'namelist' 
    156       CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    157          &         1, numout, .FALSE., 1 ) 
    158  
    159       WRITE(numout,*) 
    160       WRITE(numout,*) '                 L O D Y C - I P S L' 
    161       WRITE(numout,*) '                     O P A model' 
    162       WRITE(numout,*) '            Ocean General Circulation Model' 
    163       WRITE(numout,*) '               version OPA 9.0  (2005) ' 
    164       WRITE(numout,*) 
    165       WRITE(numout,*) 
    166  
    167       ! Namelist namctl : Control prints & Benchmark 
    168       REWIND( numnam ) 
    169       READ  ( numnam, namctl ) 
    170  
    171 #if defined key_iomput 
    172       CALL init_ioclient(localcomm) 
    173       narea = mynode(localComm) 
    174 #else 
    175       ! Nodes selection 
    176       narea = mynode() 
     144      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 ) 
     145 
     146      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print 
     147 
     148      IF(lwp) THEN                            ! open listing units 
     149         ! 
     150         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     151         ! 
     152         WRITE(numout,*) 
     153         WRITE(numout,*) '         CNRS - NERC - Met OFFICE - MERCATOR-ocean' 
     154         WRITE(numout,*) '                       NEMO team' 
     155         WRITE(numout,*) '            Ocean General Circulation Model' 
     156         WRITE(numout,*) '                  version 3.3  (2010) ' 
     157         WRITE(numout,*) 
     158         WRITE(numout,*) 
     159         DO ji = 1, SIZE(cltxt)  
     160            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
     161         END DO 
     162         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
     163         ! 
     164      ENDIF 
     165      !                             !--------------------------------! 
     166      !                             !  Model general initialization  ! 
     167      !                             !--------------------------------! 
     168 
     169      CALL opa_ctl                           ! Control prints & Benchmark 
     170 
     171      !                                      ! Domain decomposition 
     172      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
     173      ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
     174      ENDIF 
     175      ! 
     176      !                                      ! General initialization 
     177                            CALL     phy_cst    ! Physical constants 
     178                            CALL     eos_init   ! Equation of state 
     179                            CALL     dom_cfg    ! Domain configuration 
     180                            CALL     dom_init   ! Domain 
     181                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
     182 
     183      !                                     ! Ocean physics 
     184#if ! defined key_degrad 
     185                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
    177186#endif 
    178  
    179       ! Nodes selection 
    180       narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    181       lwp   = narea == 1 
    182  
    183       ! open additionnal listing 
    184       IF( ln_ctl )   THEN 
    185          IF( narea-1 > 0 )   THEN 
    186             WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1 
    187             CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   & 
    188                &         'SEQUENTIAL', 1, numout, .FALSE., 1 ) 
    189             lwp = .TRUE. 
    190             ! 
    191             WRITE(numout,*) 
    192             WRITE(numout,*) '                 L O D Y C - I P S L' 
    193             WRITE(numout,*) '                     O P A model' 
    194             WRITE(numout,*) '            Ocean General Circulation Model' 
    195             WRITE(numout,*) '               version OPA 9.0  (2005) ' 
    196             WRITE(numout,*) '                   MPI Ocean output ' 
    197             WRITE(numout,*) 
    198             WRITE(numout,*) 
    199          ENDIF 
    200       ENDIF 
    201  
    202       CALL opa_flg                          ! Control prints & Benchmark 
    203  
    204       !                                     ! ============================== ! 
    205       !                                     !  Model general initialization  ! 
    206       !                                     ! ============================== ! 
     187      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing 
     188 
     189      !                                     ! Active tracers 
     190                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
     191      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
     192 
     193      !                                     ! Passive tracers 
     194                            CALL     trc_init   ! Passive tracers initialization 
     195      !                                     ! Dynamics 
     196                            CALL dta_dyn_init   ! Initialization for the dynamics 
     197                            CALL     iom_init       ! iom_put initialization 
    207198 
    208199      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    209  
    210                                             ! Domain decomposition 
    211       IF( jpni * jpnj == jpnij ) THEN 
    212          CALL mpp_init                          ! standard cutting out 
    213       ELSE 
    214          CALL mpp_init2                         ! eliminate land processors 
    215       ENDIF 
    216        
    217       CALL phy_cst                          ! Physical constants 
    218       CALL eos_init                         ! Equation of state 
    219       CALL dom_cfg                          ! Domain configuration 
    220       CALL dom_init                         ! Domain 
    221       CALL istate_init                      ! ocean initial state (Dynamics and tracers) 
    222       CALL trc_ini                           ! Passive tracers 
    223       CALL dta_dyn( nit000 )                 ! Initialization for the dynamics 
    224       CALL tra_qsr_init                         ! Solar radiation penetration 
    225 #if ! defined key_off_degrad 
    226       CALL ldf_tra_init                         ! Lateral ocean tracer physics 
    227 #endif  
    228       CALL iom_init                         ! iom_put initialization 
    229  
    230       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    231  
     200      ! 
    232201   END SUBROUTINE opa_init 
    233202 
    234    SUBROUTINE opa_flg 
    235       !!---------------------------------------------------------------------- 
    236       !!                     ***  ROUTINE opa  *** 
    237       !! 
    238       !! ** Purpose :   Initialize logical flags that control the choice of 
    239       !!      some algorithm or control print 
    240       !! 
    241       !! ** Method  :    Read in namilist namflg logical flags 
    242       !! 
    243       !! History : 
    244       !!   9.0  !  03-11  (G. Madec)  Original code 
    245       !!---------------------------------------------------------------------- 
    246       !! * Local declarations 
    247  
    248       ! Parameter control and print 
    249       ! --------------------------- 
    250       IF(lwp) THEN 
     203 
     204   SUBROUTINE opa_ctl 
     205      !!---------------------------------------------------------------------- 
     206      !!                     ***  ROUTINE opa_ctl  *** 
     207      !! 
     208      !! ** Purpose :   control print setting  
     209      !! 
     210      !! ** Method  : - print namctl information and check some consistencies 
     211      !!---------------------------------------------------------------------- 
     212      ! 
     213      IF(lwp) THEN                  ! Parameter print 
    251214         WRITE(numout,*) 
    252215         WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 
    253216         WRITE(numout,*) '~~~~~~~ ' 
    254          WRITE(numout,*) '          Namelist namctl' 
    255          WRITE(numout,*) '             run control (for debugging)     ln_ctl    = ', ln_ctl 
    256          WRITE(numout,*) '             level of print                  nprint    = ', nprint 
    257          WRITE(numout,*) '             Start i indice for SUM control  nictls    = ', nictls 
    258          WRITE(numout,*) '             End i indice for SUM control    nictle    = ', nictle 
    259          WRITE(numout,*) '             Start j indice for SUM control  njctls    = ', njctls 
    260          WRITE(numout,*) '             End j indice for SUM control    njctle    = ', njctle 
    261          WRITE(numout,*) '             number of proc. following i     isplt     = ', isplt 
    262          WRITE(numout,*) '             number of proc. following j     jsplt     = ', jsplt 
    263          WRITE(numout,*) '             benchmark parameter (0/1)       nbench    = ', nbench 
    264       ENDIF 
    265  
    266       ! ... Control the sub-domain area indices for the control prints 
    267       IF( ln_ctl )   THEN 
    268          IF( lk_mpp )   THEN 
    269             ! the domain is forced to the real splitted domain in MPI 
    270             isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 
     217         WRITE(numout,*) '   Namelist namctl' 
     218         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl 
     219         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
     220         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
     221         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
     222         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
     223         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
     224         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
     225         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
     226         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
     227      ENDIF 
     228      ! 
     229      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
     230      nictls    = nn_ictls 
     231      nictle    = nn_ictle 
     232      njctls    = nn_jctls 
     233      njctle    = nn_jctle 
     234      isplt     = nn_isplt 
     235      jsplt     = nn_jsplt 
     236      nbench    = nn_bench 
     237      !                             ! Parameter control 
     238      ! 
     239      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints 
     240         IF( lk_mpp ) THEN 
     241            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real splitted domain 
    271242         ELSE 
    272243            IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    273                CALL ctl_warn( '          - isplt & jsplt are equal to 1',   & 
    274                     &         '          - the print control will be done over the whole domain' ) 
    275             ENDIF 
    276  
    277             ! compute the total number of processors ijsplt 
    278             ijsplt = isplt*jsplt 
     244               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
     245                  &           ' - the print control will be done over the whole domain' ) 
     246            ENDIF 
     247            ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    279248         ENDIF 
    280  
    281249         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    282250         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    283  
    284          ! Control the indices used for the SUM control 
    285          IF( nictls+nictle+njctls+njctle == 0 )   THEN 
    286             ! the print control is done over the default area 
     251         ! 
     252         !                              ! indices used for the SUM control 
     253         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    287254            lsp_area = .FALSE. 
    288          ELSE 
    289             ! the print control is done over a specific  area 
     255         ELSE                                             ! print control done over a specific  area 
    290256            lsp_area = .TRUE. 
    291257            IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
     
    293259               nictls = 1 
    294260            ENDIF 
    295  
    296261            IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    297262               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    298263               nictle = jpiglo 
    299264            ENDIF 
    300  
    301265            IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    302266               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    303267               njctls = 1 
    304268            ENDIF 
    305  
    306269            IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    307270               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    308271               njctle = jpjglo 
    309272            ENDIF 
    310  
    311          ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 ) 
    312        ENDIF            ! IF(ln_ctl) 
    313  
    314       IF( nbench == 1 )   THEN 
     273         ENDIF 
     274      ENDIF 
     275      ! 
     276      IF( nbench == 1 )   THEN            ! Benchmark  
    315277         SELECT CASE ( cp_cfg ) 
    316          CASE ( 'gyre' ) 
    317             CALL ctl_warn( '          The Benchmark is activated ' ) 
    318          CASE DEFAULT 
    319             CALL ctl_stop( '          The Benchmark is based on the GYRE configuration: key_gyre must & 
    320                &                      be used or set nbench = 0' ) 
     278         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
     279         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
     280            &                                 ' key_gyre must be used or set nbench = 0' ) 
    321281         END SELECT 
    322282      ENDIF 
    323  
    324    END SUBROUTINE opa_flg 
     283      ! 
     284      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'opa_ctl: The 1D configuration must be used ',   & 
     285         &                                               'with the IOM Input/Output manager. '        ,   & 
     286         &                                               'Compile with key_iomput enabled' ) 
     287      ! 
     288   END SUBROUTINE opa_ctl 
     289 
    325290 
    326291   SUBROUTINE opa_closefile 
     
    329294      !! 
    330295      !! ** Purpose :   Close the files 
    331       !! 
    332       !! ** Method  : 
    333       !! 
    334       !! History : 
    335       !!   9.0  !  05-01  (O. Le Galloudec)  Original code 
    336       !!---------------------------------------------------------------------- 
    337       !!---------------------------------------------------------------------- 
    338  
     296      !!---------------------------------------------------------------------- 
     297      ! 
    339298      IF ( lk_mpp ) CALL mppsync 
    340  
    341       ! 1. Unit close 
    342       ! ------------- 
    343  
    344       CLOSE( numnam )           ! namelist 
    345       CLOSE( numout )           ! standard model output file 
    346  
    347       IF(lwp) CLOSE( numstp )   ! time-step file 
    348  
    349       CALL iom_close            ! close all input/output files 
    350  
     299      ! 
     300      CALL iom_close                                 ! close all input/output files managed by iom_* 
     301      ! 
     302      IF( numstp     /= -1 )   CLOSE( numstp     )   ! time-step file 
     303      IF( numnam     /= -1 )   CLOSE( numnam     )   ! oce namelist 
     304      IF( numout     /=  6 )   CLOSE( numout     )   ! standard model output file 
     305      numout = 6                                     ! redefine numout in case it is used after this point... 
     306      ! 
    351307   END SUBROUTINE opa_closefile 
    352308 
  • trunk/NEMOGCM/NEMO/OFF_SRC/stpctl.F90

    • Property svn:eol-style deleted
    r1152 r2528  
    11MODULE stpctl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  stpctl  *** 
    4    !! Ocean run control :  gross check of the ocean time stepping 
    5    !!============================================================================== 
     4   !! Ocean run control :  Off-line case, only save the time step in numstp 
     5   !!====================================================================== 
     6   !! History :  OPA  ! 1991-03  (G. Madec) Original code 
     7   !!            6.0  ! 1992-06  (M. Imbard) 
     8   !!            8.0  ! 1997-06  (A.M. Treguier) 
     9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     10   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting 
     11   !!---------------------------------------------------------------------- 
    612 
    713   !!---------------------------------------------------------------------- 
    814   !!   stp_ctl      : Control the run 
    915   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1116   USE oce             ! ocean dynamics and tracers variables 
    1217   USE dom_oce         ! ocean space and time domain variables  
     
    1823   PRIVATE 
    1924 
    20    !! * Accessibility 
    21    PUBLIC stp_ctl           ! routine called by step.F90 
     25   PUBLIC   stp_ctl    ! routine called by opa.F90 
     26    
    2227   !!---------------------------------------------------------------------- 
    23  
     28   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
     29   !! $Id$ 
     30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     31   !!---------------------------------------------------------------------- 
    2432CONTAINS 
    2533 
    26    SUBROUTINE stp_ctl( kt ) 
     34   SUBROUTINE stp_ctl( kt, kindic ) 
    2735      !!---------------------------------------------------------------------- 
    2836      !!                    ***  ROUTINE stp_ctl  *** 
     
    3139      !! 
    3240      !! ** Method  : - Save the time step in numstp 
    33       !!              - Print it each 50 time steps 
    34       !!              - Print solver statistics in numsol  
    35       !!              - Stop the run IF problem for the solver ( indec < 0 ) 
    3641      !! 
    37       !! History : 
    38       !!        !  91-03  () 
    39       !!        !  91-11  (G. Madec) 
    40       !!        !  92-06  (M. Imbard) 
    41       !!        !  97-06  (A.M. Treguier) 
    42       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
     42      !! ** Actions :   'time.step' file containing the last ocean time-step 
    4343      !!---------------------------------------------------------------------- 
    44       !! * Arguments 
    45       INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    46  
     44      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index 
     45      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence 
    4746      !!---------------------------------------------------------------------- 
    48       !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    49       !!   $Id$ 
    50       !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    51       !!---------------------------------------------------------------------- 
    52  
     47      ! 
    5348      IF( kt == nit000 .AND. lwp ) THEN 
    5449         WRITE(numout,*) 
     
    5651         WRITE(numout,*) '~~~~~~~' 
    5752         ! open time.step file 
    58          CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
     53         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    5954      ENDIF 
    60  
    61       ! save the current time step in numstp 
    62       ! ------------------------------------ 
    63       IF(lwp) WRITE(numstp,9100) kt 
    64       IF(lwp) REWIND(numstp) 
    65 9100  FORMAT(1x, i8) 
    66  
    67  
     55      ! 
     56      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
     57      IF(lwp) REWIND( numstp )                       !  -------------------------- 
     58      ! 
    6859   END SUBROUTINE stp_ctl 
    6960 
Note: See TracChangeset for help on using the changeset viewer.