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

Changeset 1601


Ignore:
Timestamp:
2009-08-11T12:09:19+02:00 (15 years ago)
Author:
ctlod
Message:

Doctor naming of OPA namelist variables , see ticket: #526

Location:
trunk/NEMO/OPA_SRC
Files:
60 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/BDY/bdytides.F90

    r1462 r1601  
    7272      INTEGER ::   itide                  ! dummy loop index  
    7373      !! 
    74       NAMELIST/namtide/ln_tide_date, filtide, tide_cpt, tide_speed 
     74      NAMELIST/nambdy_tide/ln_tide_date, filtide, tide_cpt, tide_speed 
    7575      !!---------------------------------------------------------------------- 
    7676 
    … …  
    7979      IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
    8080 
    81       ! Namelist namtide : tidal harmonic forcing at open boundaries 
     81      ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 
    8282      ln_tide_date = .false. 
    8383      filtide(:) = '' 
    … …  
    8585      tide_cpt(:) = '' 
    8686      REWIND( numnam )                                ! Read namelist parameters 
    87       READ  ( numnam, namtide ) 
     87      READ  ( numnam, nambdy_tide ) 
    8888      !                                               ! Count number of components specified 
    8989      ntide = jptides_max 
    … …  
    118118      !                                               ! Parameter control and print 
    119119      IF( ntide < 1 ) THEN  
    120          CALL ctl_stop( '          Did not find any tidal components in namelist namtide' ) 
     120         CALL ctl_stop( '          Did not find any tidal components in namelist nambdy_tide' ) 
    121121      ELSE 
    122          IF(lwp) WRITE(numout,*) '          Namelist namtide : tidal harmonic forcing at open boundaries' 
     122         IF(lwp) WRITE(numout,*) '          Namelist nambdy_tide : tidal harmonic forcing at open boundaries' 
    123123         IF(lwp) WRITE(numout,*) '             tidal components specified ', ntide 
    124124         IF(lwp) WRITE(numout,*) '                ', tide_cpt(1:ntide) 

  • trunk/NEMO/OPA_SRC/DIA/diagap.F90

    r1334 r1601  
    44   !! Ocean diagnostics : computation of model-data tracer gap 
    55   !!====================================================================== 
     6   !! History :  OPA  ! 1991-10  (G. Madec)  Original code 
     7   !!            7.0  ! 1992-07  (M. Imbard)  Add variance and mpp staff 
     8   !!   NEMO     1.0  ! 2002-07  (G. Madec)  Free form, F90 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_diagap 
    711   !!---------------------------------------------------------------------- 
    … …  
    1014   !!   dia_gap      : model and data level mean temperature and salinity 
    1115   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1316   USE oce             ! ocean dynamics and tracers 
    1417   USE dom_oce         ! ocean space and time domain 
    … …  
    2326   PRIVATE 
    2427 
    25    !! * Routine accessibility 
    26    PUBLIC dia_gap     ! called in step.F90 module 
    27  
    28    !! * Shared module variables 
     28   PUBLIC   dia_gap    ! called in step.F90 module 
     29 
    2930   LOGICAL, PUBLIC, PARAMETER ::   lk_diagap = .TRUE.   !: model-data diagnostics flag 
    3031 
    31    !! * Module variables 
    32    INTEGER ::                 & 
    33       ngap  ,                 &  ! time step frequency 
    34       nprg                       ! switch for control print 
    35    ! netcdf files and index common 
    36    INTEGER ::   & 
    37       nhoridg, ndepidg,             & 
    38       ndex(1) 
    39    REAL(wp) ::     & 
    40       vol                        ! total ocean volume 
    41    REAL(wp), DIMENSION(jpk) ::   & 
    42       volk , volkr,           &  ! level ocean volume and its inverse 
    43       tdtag, sdtag,           &  ! level mean data temperature & salinity 
    44       tmodg, smodg               ! level mean model temperature & salinity 
     32   !                         !!* Namelist namgap : model-data gap 
     33   INTEGER ::   nn_gap = 15   ! time step frequency 
     34   INTEGER ::   nn_prg = 15   ! switch for control print 
     35 
     36   INTEGER ::   nhoridg, ndepidg, ndex(1)   ! netcdf files and index common 
     37 
     38   REAL(wp) ::   vol                        ! total ocean volume 
     39 
     40   REAL(wp), DIMENSION(jpk) ::   volk , volkr   ! level ocean volume and its inverse 
     41   REAL(wp), DIMENSION(jpk) ::   tdtag, sdtag   ! level mean data temperature & salinity 
     42   REAL(wp), DIMENSION(jpk) ::   tmodg, smodg   ! level mean model temperature & salinity 
    4543 
    4644   !! * Substitutions 
    4745#  include "domzgr_substitute.h90" 
    4846   !!---------------------------------------------------------------------- 
    49    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     47   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    5048   !! $Id$  
    51    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     49   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    5250   !!---------------------------------------------------------------------- 
    5351 
    … …  
    5957      !! 
    6058      !! ** Purpose :   Compute model and data level mean T and S profiles 
    61       !!      and output it in numgap (NetCDF or direct access file) 
    62       !! 
    63       !! ** Method : 
    64       !!         tracers (model) : tn, sn 
    65       !!         tracers (data)  : t_dta, s_dta 
    66       !!         difference between model and data tracers 
    67       !!         variance between model and data tracers 
     59      !!              and output it in numgap (NetCDF or direct access file) 
     60      !! 
     61      !! ** Method :   tracers (model) : tn, sn 
     62      !!               tracers (data)  : t_dta, s_dta 
     63      !!               difference between model and data tracers 
     64      !!               variance between model and data tracers 
    6865      !! 
    6966      !! ** Action  :   output in file numgap 
    70       !! 
    71       !! History : 
    72       !!   6.0  !  91-10  (G. Madec)  Original code 
    73       !!   7.0  !  92-07  (M. Imbard)  Add variance and mpp staff 
    74       !!   8.5  !  02-07  (G. Madec)  Free form, F90 
    7567      !!---------------------------------------------------------------------- 
    76       !! * Modules used 
    7768      USE ioipsl 
    78  
    79       !! * Arguments 
     69      !! 
    8070      INTEGER, INTENT(in) ::   kt           ! ocean time-step index 
    81  
    82       !! * local declarations 
     71      !! 
    8372      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    8473      INTEGER ::   it, itmod    ! time step indices 
    … …  
    8978      REAL(wp), DIMENSION(jpi) ::   zfoo 
    9079      REAL(wp), DIMENSION(jpj) ::   zloo 
    91  
    92       NAMELIST/namgap/ ngap, nprg 
     80      !! 
     81      NAMELIST/namgap/ nn_gap, nn_prg 
    9382      !!---------------------------------------------------------------------- 
    94  
    9583 
    9684      ! 0. initialization 
    9785      ! ----------------- 
    98  
    9986      zdt = rdt 
    10087      IF( nacc == 1 )   zdt = rdtmin 
    10188 
    10289      IF( kt == nit000 ) THEN 
    103  
    10490         IF(lwp) WRITE(numout,*) 
    10591         IF(lwp) WRITE(numout,*) 'dia_gap : level mean model-data gap' 
    10692         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    10793 
    108          ! Read diagap parameters in namelist namgap 
    109          ngap = 15 
    110          nprg = 15 
    111  
    112          REWIND( numnam ) 
     94         REWIND( numnam )            ! Read diagap parameters in namelist namgap 
    11395         READ( numnam, namgap ) 
    11496 
    115          IF(lwp) WRITE(numout,*) '          time step frequency for gap     ngap  = ',ngap 
    116          IF(lwp) WRITE(numout,*) '          switch for control print gap    nprg  = ',nprg 
     97         IF(lwp) WRITE(numout,*) '          time step frequency for gap     nn_gap  = ',nn_gap 
     98         IF(lwp) WRITE(numout,*) '          switch for control print gap    nn_prg  = ',nn_prg 
    11799 
    118100         ! horizontal slab volume (tmask_i to take into account only interior ocean domain) 
    … …  
    152134 
    153135         ! Define frequency of output and means 
    154          zsto = ngap * zdt 
     136         zsto = nn_gap * zdt 
    155137         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!) 
    156138         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time) 
    157139         ENDIF 
    158          zout = ngap * zdt 
     140         zout = nn_gap * zdt 
    159141         zmax = FLOAT( nitend - nit000 + 1 ) * zdt 
    160142         zfoo(1:jpi) = 0.e0 
    … …  
    166148         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    167149 
    168          CALL dia_nam( clhstnam, ngap, 'diagap' ) 
     150         CALL dia_nam( clhstnam, nn_gap, 'diagap' ) 
    169151         IF(lwp) WRITE(numout,*) 'Name of diagap NETCDF file ', clhstnam 
    170152         ! Horizontal grid : zphi() 
    … …  
    200182      itmod = kt - nit000 + 1       ! define time axis 
    201183      it = kt  
    202       IF( MOD( itmod, ngap ) == 0 ) THEN 
     184      IF( MOD( itmod, nn_gap ) == 0 ) THEN 
    203185 
    204186         ! initialization 
    … …  
    223205         END DO 
    224206 
    225  
    226207         ! 2. Basin averaged 
    227208         ! ----------------- 
    228           
    229209         DO jk = 1, jpkm1 
    230210            tdtag(jpk) = tdtag(jpk) + tdtag(jk) * volk(jk) / vol 
    … …  
    240220          ! 3.  Averaged output in file numgap 
    241221          ! ----------------------------====== 
    242  
    243           IF( MOD( itmod, nprg ) == 0 ) THEN 
     222          IF( MOD( itmod, nn_prg ) == 0 ) THEN 
    244223              IF(lwp) THEN 
    245224                  WRITE(numout,*) 'dia_gap: time step = ', kt, 'model - data' 
    246225                  WRITE(numout,9300) 
    247  
    248226                  DO jk = 1, jpk 
    249227                    WRITE(numout,9310) tdtag(jk), tmodg(jk), tdtag(jk) - tmodg(jk), jk, fsdept(1,1,jk),   & 
    250                                        sdtag(jk), smodg(jk), sdtag(jk) - smodg(jk) 
     228                       &               sdtag(jk), smodg(jk), sdtag(jk) - smodg(jk) 
    251229                  END DO   
    252230              ENDIF 
    … …  
    269247 
    270248      ! Closing numgap file 
    271  
    272249      IF( kt == nitend ) THEN 
    273250         CALL histclo( numgap )      !   Netcdf file 
    274251      ENDIF  
    275  
     252      ! 
    276253   END SUBROUTINE dia_gap 
    277254 

  • trunk/NEMO/OPA_SRC/DOM/closea.F90

    r1146 r1601  
    3232   PUBLIC clo_bat      ! routine called in domzgr module 
    3333 
    34    !!* Namelist namclo : closed seas and lakes 
    35    INTEGER, PUBLIC                     ::   nclosea =  0     !: = 0 no closed sea or lake 
    36       !                                                      !  = 1 closed sea or lake in the domain 
    37        
    3834   INTEGER, PUBLIC, PARAMETER          ::   jpncs   = 4      !: number of closed sea 
    3935   INTEGER, PUBLIC, DIMENSION(jpncs)   ::   ncstt            !: Type of closed sea 

  • trunk/NEMO/OPA_SRC/DOM/dom_oce.F90

    r1577 r1601  
    11MODULE dom_oce 
    2    !!---------------------------------------------------------------------- 
     2   !!====================================================================== 
    33   !!                       ***  MODULE dom_oce  *** 
    44   !!        
    55   !! ** Purpose :   Define in memory all the ocean space domain variables 
    6    !!---------------------------------------------------------------------- 
    7    !! History : 
    8    !!   9.0  !  05-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
    9    !!---------------------------------------------------------------------- 
    10    !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     6   !!====================================================================== 
     7   !! History :  1.0  ! 2005-10  (A. Beckmann, G. Madec)  reactivate s-coordinate  
     8   !!---------------------------------------------------------------------- 
     9   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    1110   !! $Id$  
    12    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    13    !!---------------------------------------------------------------------- 
    14    !! * Modules used 
     11   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     12   !!---------------------------------------------------------------------- 
    1513   USE par_oce      ! ocean parameters 
    1614 
    … …  
    2018 
    2119   !!---------------------------------------------------------------------- 
     20   !! time & space domain namelist 
     21   !! ---------------------------- 
     22   !                                              !!* Namelist namdom : time & space domain * 
     23   INTEGER , PUBLIC ::   nn_bathy     =  0         !: = 0/1 ,compute/read the bathymetry file 
     24   REAL(wp), PUBLIC ::   rn_e3zps_min = 5.0_wp     !: miminum thickness for partial steps (meters) 
     25   REAL(wp), PUBLIC ::   rn_e3zps_rat = 0.1_wp     !: minimum thickness ration for partial steps 
     26   INTEGER , PUBLIC ::   nn_msh       = 0          !: = 1 create a mesh-mask file 
     27   INTEGER , PUBLIC ::   nn_acc       = 0          !: = 0/1 use of the acceleration of convergence technique 
     28   REAL(wp), PUBLIC ::   rn_atfp      = 0.1_wp     !: asselin time filter parameter 
     29   REAL(wp), PUBLIC ::   rn_rdt       = 3600._wp   !: time step for the dynamics (and tracer if nacc=0) 
     30   REAL(wp), PUBLIC ::   rn_rdtmin    = 3600._wp   !: minimum time step on tracers 
     31   REAL(wp), PUBLIC ::   rn_rdtmax    = 3600._wp   !: maximum time step on tracers 
     32   REAL(wp), PUBLIC ::   rn_rdth      =  800._wp   !: depth variation of tracer step 
     33   INTEGER , PUBLIC ::   nn_baro      = 64         !: number of barotropic time steps (key_dynspg_ts) 
     34   INTEGER , PUBLIC ::   nn_closea    =  0         !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 
     35 
     36   !                                          ! old non-DOCTOR names still used in the model 
     37   INTEGER , PUBLIC ::   ntopo                !: = 0/1 ,compute/read the bathymetry file 
     38   REAL(wp), PUBLIC ::   e3zps_min            !: miminum thickness for partial steps (meters) 
     39   REAL(wp), PUBLIC ::   e3zps_rat            !: minimum thickness ration for partial steps 
     40   INTEGER , PUBLIC ::   nmsh                 !: = 1 create a mesh-mask file 
     41   INTEGER , PUBLIC ::   nacc                 !: = 0/1 use of the acceleration of convergence technique 
     42   REAL(wp), PUBLIC ::   atfp                 !: asselin time filter parameter 
     43   REAL(wp), PUBLIC ::   rdt                  !: time step for the dynamics (and tracer if nacc=0) 
     44   REAL(wp), PUBLIC ::   rdtmin               !: minimum time step on tracers 
     45   REAL(wp), PUBLIC ::   rdtmax               !: maximum time step on tracers 
     46   REAL(wp), PUBLIC ::   rdth                 !: depth variation of tracer step 
     47   INTEGER , PUBLIC ::   nclosea              !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 
     48 
     49 
     50   !                                         !!! associated variables 
     51   INTEGER , PUBLIC                 ::   neuler  = 0   !: restart euler forward option (0=Euler) 
     52   REAL(wp), PUBLIC                 ::   atfp1         !: asselin time filter coeff. (atfp1= 1-2*atfp) 
     53   REAL(wp), PUBLIC, DIMENSION(jpk) ::   rdttra        !: vertical profile of tracer time step 
     54 
     55   !                                         !!* Namelist namcla : cross land advection 
     56   INTEGER, PUBLIC ::   nn_cla = 0            !: =1 cross land advection for exchanges through some straits (ORCA2) 
     57 
     58   !                                          ! old non-DOCTOR names still used in the model 
     59   INTEGER, PUBLIC ::   n_cla = 0             !: =1 cross land advection for exchanges through some straits (ORCA2) 
     60 
     61   !!---------------------------------------------------------------------- 
    2262   !! space domain parameters 
    2363   !! ----------------------- 
    24    LOGICAL, PUBLIC ::   &   !: 
    25       lzoom      =  .FALSE. ,   &  !: zoom flag 
    26       lzoom_e    =  .FALSE. ,   &  !: East  zoom type flag 
    27       lzoom_w    =  .FALSE. ,   &  !: West  zoom type flag 
    28       lzoom_s    =  .FALSE. ,   &  !: South zoom type flag 
    29       lzoom_n    =  .FALSE. ,   &  !: North zoom type flag 
    30       lzoom_arct =  .FALSE. ,   &  !: ORCA    arctic zoom flag 
    31       lzoom_anta =  .FALSE.        !: ORCA antarctic zoom flag 
    32  
    33    INTEGER, PUBLIC ::           & !!: namdom : space domain (bathymetry, mesh) 
    34       ntopo   =  0 ,            &  !: = 0/1 ,compute/read the bathymetry file 
    35       nmsh    =  0                 !: = 1 create a mesh-mask file 
    36  
    37    INTEGER, PUBLIC ::         &   !: 
    38       ! domain parameters linked to mpp 
    39       nperio,          &  !: type of lateral boundary condition 
    40       nimpp, njmpp,    &  !: i- & j-indexes for mpp-subdomain left bottom 
    41       nreci, nrecj,    &  !: overlap region in i and j 
    42       nproc,           &  !: number for local processor 
    43       narea,           &  !: number for local area 
    44       nbondi, nbondj,  &  !: mark of i- and j-direction local boundaries 
    45       npolj,           &  !: north fold mark (0, 3 or 4) 
    46       nlci, nlcj,      &  !: i- & j-dimensions of the local subdomain 
    47       nldi, nlei,      &  !: first and last indoor i- and j-indexes 
    48       nldj, nlej,      &  !: 
    49       noea, nowe,      &  !: index of the local neighboring processors in 
    50       noso, nono,      &  !: east, west, south and north directions 
    51       npne, npnw,      &  !: index of north east and north west processor 
    52       npse, npsw,      &  !: index of south east and south west processor 
    53       nbne, nbnw,      &  !: logical of north east & north west processor 
    54       nbse, nbsw,      &  !: logical of south east & south west processor 
    55       nidom               !: ??? 
    56  
    57    INTEGER, PUBLIC, DIMENSION(jpi) ::   &   !: 
    58       mig                 !: local  ==> global  domain i-indice 
    59    INTEGER, PUBLIC, DIMENSION(jpj) ::   &   !: 
    60       mjg                 !: local  ==> global  domain j-indice 
    61    INTEGER, PUBLIC, DIMENSION( jpidta ) ::   &  !:  !!bug ==> other solution? 
    62       mi0, mi1            !: global ==> local domain i-indice 
    63       !                   !  (mi0=1 and mi1=0 if the global indice is not in the local domain) 
    64    INTEGER, PUBLIC, DIMENSION( jpjdta ) ::   &  !: 
    65       mj0, mj1            !: global ==> local domain j-indice 
    66       !                   ! (mi0=1 and mi1=0 if the global indice is not in the local domain) 
    67  
    68    INTEGER, PUBLIC, DIMENSION(jpnij) ::   &  !: 
    69       nimppt, njmppt,  &  !: i-, j-indexes for each processor 
    70       ibonit, ibonjt,  &  !: i-, j- processor neighbour existence 
    71       nlcit , nlcjt,   &  !: dimensions of every subdomain 
    72       nldit , nldjt,   &  !: first, last indoor index for each i-domain 
    73       nleit , nlejt       !: first, last indoor index for each j-domain 
     64   LOGICAL, PUBLIC ::   lzoom      =  .FALSE.   !: zoom flag 
     65   LOGICAL, PUBLIC ::   lzoom_e    =  .FALSE.   !: East  zoom type flag 
     66   LOGICAL, PUBLIC ::   lzoom_w    =  .FALSE.   !: West  zoom type flag 
     67   LOGICAL, PUBLIC ::   lzoom_s    =  .FALSE.   !: South zoom type flag 
     68   LOGICAL, PUBLIC ::   lzoom_n    =  .FALSE.   !: North zoom type flag 
     69   LOGICAL, PUBLIC ::   lzoom_arct =  .FALSE.   !: ORCA    arctic zoom flag 
     70   LOGICAL, PUBLIC ::   lzoom_anta =  .FALSE.   !: ORCA antarctic zoom flag 
     71 
     72   !                                     !!! domain parameters linked to mpp 
     73   INTEGER, PUBLIC ::   nperio            !: type of lateral boundary condition 
     74   INTEGER, PUBLIC ::   nimpp, njmpp      !: i- & j-indexes for mpp-subdomain left bottom 
     75   INTEGER, PUBLIC ::   nreci, nrecj      !: overlap region in i and j 
     76   INTEGER, PUBLIC ::   nproc             !: number for local processor 
     77   INTEGER, PUBLIC ::   narea             !: number for local area 
     78   INTEGER, PUBLIC ::   nbondi, nbondj    !: mark of i- and j-direction local boundaries 
     79   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4) 
     80   INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices 
     81   INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices 
     82   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in 
     83   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions 
     84   INTEGER, PUBLIC ::   npne, npnw        !: index of north east and north west processor 
     85   INTEGER, PUBLIC ::   npse, npsw        !: index of south east and south west processor 
     86   INTEGER, PUBLIC ::   nbne, nbnw        !: logical of north east & north west processor 
     87   INTEGER, PUBLIC ::   nbse, nbsw        !: logical of south east & south west processor 
     88   INTEGER, PUBLIC ::   nidom             !: ??? 
     89 
     90   INTEGER, PUBLIC, DIMENSION(jpi)    ::   mig        !: local  ==> global domain i-index 
     91   INTEGER, PUBLIC, DIMENSION(jpj)    ::   mjg        !: local  ==> global domain j-index 
     92   INTEGER, PUBLIC, DIMENSION(jpidta) ::   mi0, mi1   !: global ==> local  domain i-index    !!bug ==> other solution? 
     93   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain) 
     94   INTEGER, PUBLIC, DIMENSION(jpjdta) ::   mj0, mj1   !: global ==> local  domain j-index     !!bug ==> other solution? 
     95   !                                                  ! (mi0=1 and mi1=0 if the global index is not in the local domain) 
     96   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nimppt, njmppt   !: i-, j-indexes for each processor 
     97   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
     98   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nlcit , nlcjt    !: dimensions of every subdomain 
     99   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nldit , nldjt    !: first, last indoor index for each i-domain 
     100   INTEGER, PUBLIC, DIMENSION(jpnij)  ::   nleit , nlejt    !: first, last indoor index for each j-domain 
    74101 
    75102   !!---------------------------------------------------------------------- 
    76103   !! horizontal curvilinear coordinate and scale factors 
    77104   !! --------------------------------------------------------------------- 
    78  
    79    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    80       glamt, glamu,    &  !: longitude of t-, u-, v- and f-points (degre) 
    81       glamv, glamf,    &  !: 
    82       gphit, gphiu,    &  !: latitude  of t-, u-, v- and f-points (degre) 
    83       gphiv, gphif,    &  !: 
    84       e1t, e2t,        &  !: horizontal scale factors at t-point (m) 
    85       e1u, e2u,        &  !: horizontal scale factors at u-point (m) 
    86       e1v, e2v,        &  !: horizontal scale factors at v-point (m) 
    87       e1f, e2f,        &  !: horizontal scale factors at f-point (m) 
    88       ff                  !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
     105   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   glamt, glamu   !: longitude of t-, u-, v- and f-points (degre) 
     106   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   glamv, glamf   !: 
     107   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
     108   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   gphiv, gphif   !: 
     109   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1t, e2t       !: horizontal scale factors at t-point (m) 
     110   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1u, e2u       !: horizontal scale factors at u-point (m) 
     111   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1v, e2v       !: horizontal scale factors at v-point (m) 
     112   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e1f, e2f       !: horizontal scale factors at f-point (m) 
     113   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
    89114 
    90115   !!---------------------------------------------------------------------- 
    91116   !! vertical coordinate and scale factors 
    92117   !! -------------------------------------- 
    93  
    94    LOGICAL, PUBLIC ::           & !!: namzgr : vertical coordinate 
    95       ln_zco     =  .TRUE.  ,   &  !: z-coordinate - full step 
    96       ln_zps     =  .FALSE. ,   &  !: z-coordinate - partial step 
    97       ln_sco     =  .FALSE.        !: s-coordinate or hybrid z-s coordinate 
    98  
     118   !                                           !!* Namelist namzgr : vertical coordinate * 
     119   LOGICAL, PUBLIC ::   ln_zco     =  .TRUE.    !: z-coordinate - full step 
     120   LOGICAL, PUBLIC ::   ln_zps     =  .FALSE.   !: z-coordinate - partial step 
     121   LOGICAL, PUBLIC ::   ln_sco     =  .FALSE.   !: s-coordinate or hybrid z-s coordinate 
    99122#if defined key_zco 
    100123   LOGICAL, PUBLIC, PARAMETER ::   lk_zco = .TRUE.    !: z-coordinate flag (1D arrays) 
    … …  
    104127   !! All coordinates 
    105128   !! --------------- 
    106    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    107       gdep3w        ,    &  !: depth of T-points (sum of e3w) (m) 
    108       gdept , gdepw ,    &  !: analytical depth at T-W  points (m) 
    109       e3v   , e3f   ,    &  !: analytical vertical scale factors at  V--F 
    110       e3t   , e3u   ,    &  !:                                       T--U  points (m) 
    111       e3vw          ,    &  !: analytical vertical scale factors at  VW-- 
    112       e3w   , e3uw          !:                                        W--UW  points (m) 
     129   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdep3w          !: depth of T-points (sum of e3w) (m) 
     130   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   gdept , gdepw   !: analytical depth at T-W  points (m) 
     131   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3v   , e3f     !: analytical vertical scale factors at  V--F 
     132   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3t   , e3u     !:                                       T--U  points (m) 
     133   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3vw            !: analytical vertical scale factors at  VW-- 
     134   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   e3w   , e3uw    !:                                        W--UW  points (m) 
    113135#endif 
    114136#if defined key_vvl 
    115137   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .TRUE.    !: variable grid flag 
     138 
    116139   !! All coordinates 
    117140   !! --------------- 
    … …  
    125148   LOGICAL, PUBLIC, PARAMETER ::   lk_vvl = .FALSE.   !: fixed grid flag 
    126149#endif 
    127    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    128       hur, hvr,          &  !: inverse of u and v-points ocean depth (1/m) 
    129       hu , hv,           &  !: depth at u- and v-points (meters) 
    130       hu_0 , hv_0           !: refernce depth at u- and v-points (meters) 
    131  
    132    INTEGER, PUBLIC            ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
    133    INTEGER, PUBLIC            ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1)  
     150   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hur  , hvr    !: inverse of u and v-points ocean depth (1/m) 
     151   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hu   , hv     !: depth at u- and v-points (meters) 
     152   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hu_0 , hv_0   !: refernce depth at u- and v-points (meters) 
     153 
     154   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
     155   INTEGER, PUBLIC ::   nlb10              !: shallowest W level Bellow ~10m (nla10 + 1)  
    134156 
    135157   !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 
    136158   !! =-----------------====------ 
    137    REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !: 
    138       gdept_0, gdepw_0,       &  !: reference depth of t- and w-points (m) 
    139       e3t_0  , e3w_0             !: reference vertical scale factors at T- and W-pts (m) 
    140  
    141    !! z-coordinate with partial steps 
    142    !! =-----------------=======------ 
    143    REAL(wp), PUBLIC ::      & !!: * namelist namdom * 
    144       e3zps_min = 5.0_wp,   &  !: miminum thickness for partial steps (meters) 
    145       e3zps_rat = 0.1_wp       !: minimum thickness ration for partial steps 
    146  
    147    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  !: 
    148       hdept, hdepw, e3tp, e3wp   !: bottom depth and thickness at T and W points 
     159   REAL(wp), PUBLIC, DIMENSION(jpk)     ::   gdept_0, gdepw_0   !: reference depth of t- and w-points (m) 
     160   REAL(wp), PUBLIC, DIMENSION(jpk)     ::   e3t_0  , e3w_0     !: reference vertical scale factors at T- and W-pts (m) 
     161   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hdept  , hdepw     !: ocean bottom depth at T and W points 
     162   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   e3tp   , e3wp      !: ocean bottom level thickness at T and W points 
    149163 
    150164   !! s-coordinate and hybrid z-s-coordinate 
    151165   !! =----------------======--------------- 
    152    REAL(wp), PUBLIC, DIMENSION(jpk) ::   &   !: 
    153       gsigt, gsigw ,   &  !: model level depth coefficient at t-, w-levels (analytic) 
    154       gsi3w        ,   &  !: model level depth coefficient at w-level (sum of gsigw) 
    155       esigt, esigw        !: vertical scale factor coef. at t-, w-levels 
    156  
    157    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    158       hbatv , hbatf ,   &  !: ocean depth at the vertical of  V--F 
    159       hbatt , hbatu ,   &  !:                                 T--U  points (m) 
    160       scosrf, scobot,   &  !:  ocean surface and bottom topographies (if deviating from coordinate surfaces in HYBRID) 
    161       hifv  , hiff  ,   &  !: interface depth between stretching    at  V--F 
    162       hift  , hifu         !: and quasi-uniform spacing                 T--U  points (m) 
     166   REAL(wp), PUBLIC, DIMENSION(jpk) ::   gsigt, gsigw   !: model level depth coefficient at t-, w-levels (analytic) 
     167   REAL(wp), PUBLIC, DIMENSION(jpk) ::   gsi3w          !: model level depth coefficient at w-level (sum of gsigw) 
     168   REAL(wp), PUBLIC, DIMENSION(jpk) ::   esigt, esigw   !: vertical scale factor coef. at t-, w-levels 
     169 
     170   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hbatv , hbatf    !: ocean depth at the vertical of  V--F 
     171   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hbatt , hbatu    !:                                 T--U  points (m) 
     172   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   scosrf, scobot   !: ocean surface and bottom topographies  
     173   !                                                          !  (if deviating from coordinate surfaces in HYBRID) 
     174   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hifv  , hiff     !: interface depth between stretching    at  V--F 
     175   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hift  , hifu     !: and quasi-uniform spacing                 T--U  points (m) 
    163176 
    164177   !!---------------------------------------------------------------------- 
    165178   !! masks, bathymetry 
    166179   !! ----------------- 
    167  
    168    INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    169       mbathy     !: number of ocean level (=0, 1, ... , jpk-1) 
    170  
    171    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &   !: 
    172       bathy  ,         &  !: ocean depth (meters) 
    173       tmask_i,         &  !: interior domain T-point mask 
    174       bmask               !: land/ocean mask of barotropic stream function 
    175  
    176    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &   !: 
    177       tmask, umask,    &  !: land/ocean mask at T-, U-, V- and F-points 
    178       vmask, fmask        !: 
    179  
    180    REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   &   !: 
    181       tpol, fpol          !: north fold mask (nperio= 3 or 4) 
     180   INTEGER , PUBLIC, DIMENSION(jpi,jpj) ::   mbathy    !: number of ocean level (=0, 1, ... , jpk-1) 
     181   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bathy     !: ocean depth (meters) 
     182   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tmask_i   !: interior domain T-point mask 
     183   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   bmask     !: land/ocean mask of barotropic stream function 
     184 
     185   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-points 
     186 
     187   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol          !: north fold mask (nperio= 3 or 4) 
    182188 
    183189#if defined key_noslip_accurate 
    184    INTEGER, PUBLIC, DIMENSION(4,jpk) ::   &   !: 
    185       npcoa               !: ??? 
    186    INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) ::   &   !: 
    187       nicoa,           &  !: ??? 
    188       njcoa               !: ??? 
     190   INTEGER, PUBLIC, DIMENSION            (4,jpk) ::   npcoa          !: ??? 
     191   INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) ::   nicoa, njcoa   !: ??? 
    189192#endif 
    190193 
    … …  
    198201#endif 
    199202 
    200  
    201    !!---------------------------------------------------------------------- 
    202    !! time domain 
    203    !!---------------------------------------------------------------------- 
    204    INTEGER, PUBLIC ::      & !!: * Namelist * ??? 
    205       nacc   = 0   ,       &  !: = 0/1 use of the acceleration of convergence technique 
    206       neuler       ,       &  !: restart euler forward option (0=Euler) 
    207       nn_baro = 64            !: number of barotropic time steps (key_dynspg_ts) 
    208  
    209    REAL(wp), PUBLIC ::       & !!: * Namelist ??? * 
    210       rdt    = 3600._wp ,    &  !: time step for the dynamics (and tracer if nacc=0) 
    211       rdtmin = 3600._wp ,    &  !: minimum time step on tracers 
    212       rdtmax = 3600._wp ,    &  !: maximum time step on tracers 
    213       rdth   =  800._wp ,    &  !: depth variation of tracer step 
    214       atfp   = 0.1_wp   ,    &  !: asselin time filter parameter 
    215       atfp1                     !: asselin time filter coeff. (atfp1= 1-2*atfp) 
    216  
    217    REAL(wp), PUBLIC, DIMENSION(jpk) ::   &  !: 
    218       rdttra                    !: vertical profile of tracer time step 
    219  
    220    !!---------------------------------------------------------------------- 
    221    !! cross land advection 
    222    !!---------------------------------------------------------------------- 
    223  
    224    INTEGER, PUBLIC ::       & !!: namelist ??? 
    225       n_cla                    !: flag (0/1) for cross land advection to 
    226       !                        ! parameterize exchanges through straits 
    227  
     203   !!====================================================================== 
    228204END MODULE dom_oce 

  • trunk/NEMO/OPA_SRC/DOM/domain.F90

    r1488 r1601  
    55   !!============================================================================== 
    66   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code 
    7    !!                 !  1991-11  (G. Madec) 
    87   !!                 !  1992-01  (M. Imbard) insert time step initialization 
    98   !!                 !  1996-06  (G. Madec) generalized vertical coordinate  
    … …  
    2322   USE sbc_oce         ! surface boundary condition: ocean 
    2423   USE phycst          ! physical constants 
     24   USE closea          ! closed seas 
    2525   USE in_out_manager  ! I/O manager 
    2626   USE lib_mpp         ! distributed memory computing library 
    … …  
    3131   USE dommsk          ! domain: set the mask system 
    3232   USE domwri          ! domain: write the meshmask file 
    33    USE closea          ! closed sea or lake              (dom_clo routine) 
    3433   USE domvvl          ! variable volume 
    3534 
    … …  
    5453      !!                     
    5554      !! ** Purpose :   Domain initialization. Call the routines that are  
    56       !!      required to create the arrays which define the space and time 
    57       !!      domain of the ocean model. 
     55      !!              required to create the arrays which define the space  
     56      !!              and time domain of the ocean model. 
    5857      !! 
    59       !! ** Method  : 
    60       !!      - dom_msk: compute the masks from the bathymetry file 
    61       !!      - dom_hgr: compute or read the horizontal grid-point position and 
    62       !!                scale factors, and the coriolis factor 
    63       !!      - dom_zgr: define the vertical coordinate system and the bathymetry 
    64       !!      - dom_stp: defined the model time step 
    65       !!      - dom_wri: create the meshmask file if nmsh=1 
     58      !! ** Method  : - dom_msk: compute the masks from the bathymetry file 
     59      !!              - dom_hgr: compute or read the horizontal grid-point position 
     60      !!                         and scale factors, and the coriolis factor 
     61      !!              - dom_zgr: define the vertical coordinate and the bathymetry 
     62      !!              - dom_stp: defined the model time step 
     63      !!              - dom_wri: create the meshmask file if nmsh=1 
    6664      !!---------------------------------------------------------------------- 
    6765      INTEGER ::   jk                ! dummy loop argument 
    6866      INTEGER ::   iconf = 0         ! temporary integers 
    6967      !!---------------------------------------------------------------------- 
    70  
     68      ! 
    7169      IF(lwp) THEN 
    7270         WRITE(numout,*) 
    … …  
    7472         WRITE(numout,*) '~~~~~~~~' 
    7573      ENDIF 
    76  
    77       CALL dom_nam                        ! read namelist ( namrun, namdom, namcla ) 
    78  
    79       CALL dom_clo                        ! Closed seas and lake 
    80  
    81       CALL dom_hgr                        ! Horizontal mesh 
    82  
    83       CALL dom_zgr                        ! Vertical mesh and bathymetry 
    84  
    85       CALL dom_msk                        ! Masks 
    86  
    87       IF( lk_vvl )   CALL dom_vvl         ! Vertical variable mesh 
    88  
    89       ! Local depth or Inverse of the local depth of the water column at u- and v-points 
    90       ! ------------------------------ 
    91       ! Ocean depth at U- and V-points 
    92       hu(:,:) = 0.e0 
     74      ! 
     75                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
     76                             CALL dom_clo      ! Closed seas and lake 
     77                             CALL dom_hgr      ! Horizontal mesh 
     78                             CALL dom_zgr      ! Vertical mesh and bathymetry 
     79                             CALL dom_msk      ! Masks 
     80      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh 
     81      ! 
     82      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points 
    9383      hv(:,:) = 0.e0 
    9484      DO jk = 1, jpk 
    … …  
    9686         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) 
    9787      END DO 
    98       ! Inverse of the local depth 
    99       hur(:,:) = fse3u(:,:,1)             ! Lower bound : thickness of the first model level 
    100       hvr(:,:) = fse3v(:,:,1) 
    101       DO jk = 2, jpk                      ! Sum of the vertical scale factors 
    102          hur(:,:) = hur(:,:) + fse3u(:,:,jk) * umask(:,:,jk) 
    103          hvr(:,:) = hvr(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) 
    104       END DO 
    105       ! Compute and mask the inverse of the local depth 
    106       hur(:,:) = 1. / hur(:,:) * umask(:,:,1) 
    107       hvr(:,:) = 1. / hvr(:,:) * vmask(:,:,1) 
    108  
    109       CALL dom_stp                        ! Time step 
    110  
    111       IF( nmsh /= 0 )   CALL dom_wri      ! Create a domain file 
    112  
    113       IF( .NOT.ln_rstart )   CALL dom_ctl    ! Domain control 
     88      !                                        ! Inverse of the local depth 
     89      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1) 
     90      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1) 
     91 
     92                             CALL dom_stp      ! time step 
     93      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file 
     94      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control 
    11495      ! 
    11596   END SUBROUTINE dom_init 
    … …  
    127108      !!---------------------------------------------------------------------- 
    128109      USE ioipsl 
    129       NAMELIST/namrun/ no    , cexper, cn_ocerst_in, cn_ocerst_out, ln_rstart, nrstdt,   & 
    130          &             nit000, nitend, ndate0      , nleapy       , ninist   , nstock,   & 
    131          &             nwrite, ln_dimgnnn, ln_mskland, ln_clobber, nn_chunksz 
    132  
    133       NAMELIST/namdom/ ntopo , e3zps_min, e3zps_rat, nmsh   ,   & 
    134          &             nacc  , atfp     , rdt      , rdtmin ,   & 
    135          &             rdtmax, rdth     , nn_baro  , nclosea 
    136       NAMELIST/namcla/ n_cla 
    137       !!---------------------------------------------------------------------- 
    138  
    139       IF(lwp) THEN 
     110      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     111         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
     112         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz 
     113      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh   ,   & 
     114         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin,   & 
     115         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea 
     116      NAMELIST/namcla/ nn_cla 
     117      !!---------------------------------------------------------------------- 
     118 
     119      REWIND( numnam )              ! Namelist namrun : parameters of the run 
     120      READ  ( numnam, namrun ) 
     121      ! 
     122      IF(lwp) THEN                  ! control print 
    140123         WRITE(numout,*) 
    141124         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read' 
    142125         WRITE(numout,*) '~~~~~~~ ' 
    143       ENDIF 
    144  
    145       REWIND( numnam )              ! Namelist namrun : parameters of the run 
    146       READ  ( numnam, namrun ) 
    147       IF(lwp) THEN 
    148          WRITE(numout,*) '        Namelist namrun' 
    149          WRITE(numout,*) '           job number                      no        = ', no 
    150          WRITE(numout,*) '           experiment name for output      cexper    = ', cexper 
    151          WRITE(numout,*) '           restart logical                 ln_rstart = ', ln_rstart 
    152          WRITE(numout,*) '           control of time step            nrstdt    = ', nrstdt 
    153          WRITE(numout,*) '           number of the first time step   nit000    = ', nit000 
    154          WRITE(numout,*) '           number of the last time step    nitend    = ', nitend 
    155          WRITE(numout,*) '           initial calendar date aammjj    ndate0    = ', ndate0 
    156          WRITE(numout,*) '           leap year calendar (0/1)        nleapy    = ', nleapy 
    157          WRITE(numout,*) '           initial state output            ninist    = ', ninist 
    158          WRITE(numout,*) '           frequency of restart file       nstock    = ', nstock 
    159          WRITE(numout,*) '           frequency of output file        nwrite    = ', nwrite 
    160          WRITE(numout,*) '           multi file dimgout           ln_dimgnnn   = ', ln_dimgnnn 
    161          WRITE(numout,*) '           mask land points             ln_mskland   = ', ln_mskland 
    162          WRITE(numout,*) '           overwrite an existing file   ln_clobber   = ', ln_clobber 
    163          WRITE(numout,*) '           NetCDF chunksize (bytes)     nn_chunksz   = ', nn_chunksz 
    164       ENDIF 
    165  
    166       ! ... Control of output frequency 
     126         WRITE(numout,*) '   Namelist namrun' 
     127         WRITE(numout,*) '      job number                      nn_no      = ', nn_no 
     128         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp 
     129         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
     130         WRITE(numout,*) '      control of time step            nn_rstdt   = ', nn_rstctl 
     131         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000 
     132         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend 
     133         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0 
     134         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy 
     135         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
     136         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     137         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write 
     138         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 
     139         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland 
     140         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
     141         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
     142      ENDIF 
     143 
     144      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon) 
     145      cexper = cn_exp 
     146      nrstdt = nn_rstctl 
     147      nit000 = nn_it000 
     148      nitend = nn_itend 
     149      ndate0 = nn_date0 
     150      nleapy = nn_leapy 
     151      ninist = nn_istate 
     152      nstock = nn_stock 
     153      nwrite = nn_write 
     154 
     155 
     156      !                             ! control of output frequency 
    167157      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
    168          WRITE(ctmp1,*) '           nstock = ', nstock, ' it is forced to ', nitend 
     158         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 
    169159         CALL ctl_warn( ctmp1 ) 
    170160         nstock = nitend 
    171161      ENDIF 
    172162      IF ( nwrite == 0 ) THEN 
    173          WRITE(ctmp1,*) '           nwrite = ', nwrite, ' it is forced to ', nitend 
     163         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 
    174164         CALL ctl_warn( ctmp1 ) 
    175165         nwrite = nitend 
    … …  
    177167 
    178168#if defined key_agrif 
    179       if ( Agrif_Root() ) then 
     169      IF( Agrif_Root() ) THEN 
    180170#endif 
    181       SELECT CASE ( nleapy )   ! Choose calendar for IOIPSL 
     171      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    182172      CASE (  1 )  
    183173         CALL ioconf_calendar('gregorian') 
    184          IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "gregorian", i.e. leap year' 
     174         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
    185175      CASE (  0 ) 
    186176         CALL ioconf_calendar('noleap') 
    187          IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "noleap", i.e. no leap year' 
     177         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
    188178      CASE ( 30 ) 
    189179         CALL ioconf_calendar('360d') 
    190          IF(lwp) WRITE(numout,*) '           The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     180         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    191181      END SELECT 
    192182#if defined key_agrif 
    193       endif 
     183      ENDIF 
    194184#endif 
    195185 
    196       SELECT CASE ( nleapy )   ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ... 
     186      SELECT CASE ( nleapy )       ! year=raajj*days day=rjjhh*hours hour=rhhmm*minutes etc ... 
    197187      CASE ( 1 ) 
    198188         raajj = 365.25 
    … …  
    210200      IF(lwp) THEN 
    211201         WRITE(numout,*) 
    212          WRITE(numout,*) '           nb of days per year      raajj = ', raajj,' days' 
    213          WRITE(numout,*) '           nb of seconds per year   raass = ', raass, ' s' 
    214          WRITE(numout,*) '           nb of seconds per month  rmoss = ', rmoss, ' s' 
    215       ENDIF 
    216  
    217       REWIND( numnam )              ! Namelist namdom : space/time domain (bathymetry, mesh, timestep) 
     202         WRITE(numout,*) '   nb of days per year      raajj = ', raajj,' days' 
     203         WRITE(numout,*) '   nb of seconds per year   raass = ', raass, ' s' 
     204         WRITE(numout,*) '   nb of seconds per month  rmoss = ', rmoss, ' s' 
     205      ENDIF 
     206 
     207      REWIND( numnam )             ! Namelist namdom : space & time domain (bathymetry, mesh, timestep) 
    218208      READ  ( numnam, namdom ) 
    219209 
    220210      IF(lwp) THEN 
    221211         WRITE(numout,*) 
    222          WRITE(numout,*) '        Namelist namdom' 
    223          WRITE(numout,*) '           flag read/compute bathymetry   ntopo     = ', ntopo 
    224          WRITE(numout,*) '           minimum thickness of partial   e3zps_min = ', e3zps_min, ' (m)' 
    225          WRITE(numout,*) '              step level                  e3zps_rat = ', e3zps_rat 
    226          WRITE(numout,*) '           flag write mesh/mask file(s)   nmsh      = ', nmsh 
    227          WRITE(numout,*) '                = 0   no file created                 ' 
    228          WRITE(numout,*) '                = 1   mesh_mask                       ' 
    229          WRITE(numout,*) '                = 2   mesh and mask                   ' 
    230          WRITE(numout,*) '                = 3   mesh_hgr, msh_zgr and mask      ' 
    231          WRITE(numout,*) '           acceleration of converge       nacc      = ', nacc 
    232          WRITE(numout,*) '           asselin time filter parameter  atfp      = ', atfp 
    233          WRITE(numout,*) '           time step                      rdt       = ', rdt 
    234          WRITE(numout,*) '           minimum time step on tracers   rdtmin    = ', rdtmin 
    235          WRITE(numout,*) '           maximum time step on tracers   rdtmax    = ', rdtmax 
    236          WRITE(numout,*) '           depth variation tracer step    rdth      = ', rdth 
    237          WRITE(numout,*) '           number of barotropic time step nn_baro   = ', nn_baro 
    238       ENDIF 
    239  
    240       n_cla = 0 
    241       REWIND( numnam )              ! Namelist cross land advection 
     212         WRITE(numout,*) '   Namelist namdom : space & time domain' 
     213         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy 
     214         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)' 
     215         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat 
     216         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh 
     217         WRITE(numout,*) '           = 0   no file created                 ' 
     218         WRITE(numout,*) '           = 1   mesh_mask                       ' 
     219         WRITE(numout,*) '           = 2   mesh and mask                   ' 
     220         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      ' 
     221         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt 
     222         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp 
     223         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro 
     224         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc 
     225         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin 
     226         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax 
     227         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth 
     228         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea 
     229      ENDIF 
     230 
     231      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon) 
     232      e3zps_min = rn_e3zps_min 
     233      e3zps_rat = rn_e3zps_rat 
     234      nmsh      = nn_msh 
     235      nacc      = nn_acc 
     236      atfp      = rn_atfp 
     237      rdt       = rn_rdt 
     238      rdtmin    = rn_rdtmin 
     239      rdtmax    = rn_rdtmin 
     240      rdth      = rn_rdth 
     241      nclosea   = nn_closea 
     242 
     243      REWIND( numnam )             ! Namelist cross land advection 
    242244      READ  ( numnam, namcla ) 
    243245      IF(lwp) THEN 
    244246         WRITE(numout,*) 
    245          WRITE(numout,*) '        Namelist namcla' 
    246          WRITE(numout,*) '           cross land advection        n_cla        = ',n_cla 
    247       ENDIF 
     247         WRITE(numout,*) '   Namelist namcla' 
     248         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla 
     249      ENDIF 
     250 
     251      n_cla = nn_cla                ! conversion DOCTOR names into model names (this should disappear soon) 
    248252 
    249253      IF( nbit_cmp == 1 .AND. n_cla /= 0 )   CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require n_cla = 0' ) 
    … …  
    261265      !!---------------------------------------------------------------------- 
    262266      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
    263       INTEGER, DIMENSION(2) ::   iloc      !  
     267      INTEGER, DIMENSION(2) ::   iloc   !  
    264268      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
    265269      !!---------------------------------------------------------------------- 
    266  
    267       IF(lwp)WRITE(numout,*) 
    268       IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
    269       IF(lwp)WRITE(numout,*) '~~~~~~~' 
    270  
    271       IF (lk_mpp) THEN 
     270      ! 
     271      IF(lk_mpp) THEN 
    272272         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 ) 
    273273         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 ) 
    … …  
    293293         ijma2 = iloc(2) + njmpp - 1 
    294294      ENDIF 
    295  
    296       IF(lwp) THEN 
     295      IF(lwp) THEN 
     296         WRITE(numout,*) 
     297         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
     298         WRITE(numout,*) '~~~~~~~' 
    297299         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
    298300         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1 

  • trunk/NEMO/OPA_SRC/DOM/dommsk.F90

    r1566 r1601  
    3636   PUBLIC   dom_msk    ! routine called by inidom.F90 
    3737 
    38    REAL(wp) ::   shlat = 2.   ! type of lateral boundary condition on velocity (namelist namlbc) 
     38   !                            !!* Namelist namlbc : lateral boundary condition * 
     39   REAL(wp) ::   rn_shlat = 2.   ! type of lateral boundary condition on velocity 
    3940    
    4041   !! * Substitutions 
    … …  
    7778      !! 
    7879      !!        The lateral friction is set through the value of fmask along 
    79       !!      the coast and topography. This value is defined by shlat, a 
     80      !!      the coast and topography. This value is defined by rn_shlat, a 
    8081      !!      namelist parameter: 
    81       !!         shlat = 0, free slip  (no shear along the coast) 
    82       !!         shlat = 2, no slip  (specified zero velocity at the coast) 
    83       !!         0 < shlat < 2, partial slip   | non-linear velocity profile 
    84       !!         2 < shlat, strong slip        | in the lateral boundary layer 
     82      !!         rn_shlat = 0, free slip  (no shear along the coast) 
     83      !!         rn_shlat = 2, no slip  (specified zero velocity at the coast) 
     84      !!         0 < rn_shlat < 2, partial slip   | non-linear velocity profile 
     85      !!         2 < rn_shlat, strong slip        | in the lateral boundary layer 
    8586      !! 
    8687      !!      N.B. If nperio not equal to 0, the land/ocean mask arrays 
    … …  
    106107      !!               vmask    : land/ocean mask at v-point (=0. or 1.) 
    107108      !!               fmask    : land/ocean mask at f-point (=0. or 1.) 
    108       !!                          =shlat along lateral boundaries 
     109      !!                          =rn_shlat along lateral boundaries 
    109110      !!               bmask    : land/ocean mask at barotropic stream 
    110111      !!                          function point (=0. or 1.) and set to 0 along lateral boundaries 
    … …  
    114115      INTEGER  ::   iif, iil, ii0, ii1, ii 
    115116      INTEGER  ::   ijf, ijl, ij0, ij1 
    116       INTEGER, DIMENSION(jpi,jpj) ::  imsk 
     117      INTEGER , DIMENSION(jpi,jpj) ::  imsk 
    117118      REAL(wp), DIMENSION(jpi,jpj) ::   zwf 
    118  
    119       NAMELIST/namlbc/ shlat 
     119      !! 
     120      NAMELIST/namlbc/ rn_shlat 
    120121      !!--------------------------------------------------------------------- 
    121122       
    … …  
    128129         WRITE(numout,*) '~~~~~~' 
    129130         WRITE(numout,*) '   Namelist namlbc' 
    130          WRITE(numout,*) '      lateral momentum boundary cond. shlat = ',shlat 
    131       ENDIF 
    132  
    133       IF(             shlat == 0.            ) THEN   ;   IF(lwp) WRITE(numout,*) '         ocean lateral free-slip ' 
    134         ELSEIF (      shlat == 2.            ) THEN   ;   IF(lwp) WRITE(numout,*) '         ocean lateral  no-slip ' 
    135         ELSEIF ( 0. < shlat .AND. shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '         ocean lateral  partial-slip ' 
    136         ELSEIF ( 2. < shlat                  ) THEN   ;   IF(lwp) WRITE(numout,*) '         ocean lateral  strong-slip ' 
    137         ELSE 
    138           WRITE(ctmp1,*) ' shlat is negative = ', shlat 
    139           CALL ctl_stop( ctmp1 ) 
     131         WRITE(numout,*) '      lateral momentum boundary cond.    rn_shlat = ',rn_shlat 
     132      ENDIF 
     133 
     134      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral free-slip ' 
     135      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  no-slip ' 
     136      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  partial-slip ' 
     137      ELSEIF ( 2. < rn_shlat                     ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  strong-slip ' 
     138      ELSE 
     139         WRITE(ctmp1,*) ' rn_shlat is negative = ', rn_shlat 
     140         CALL ctl_stop( ctmp1 ) 
    140141      ENDIF 
    141142 
    … …  
    148149         DO jj = 1, jpj 
    149150            DO ji = 1, jpi 
    150                IF( REAL( mbathy(ji,jj) - jk ) +.1 >= 0.e0 ) tmask(ji,jj,jk) = 1.e0 
     151               IF( REAL( mbathy(ji,jj) - jk ) +.1 >= 0.e0 )   tmask(ji,jj,jk) = 1.e0 
    151152            END DO   
    152153         END DO   
    … …  
    155156!!gm  ???? 
    156157#if defined key_zdfkpp 
    157       IF( cp_cfg == 'orca' )   THEN 
    158          IF( jp_cfg == 2 )   THEN 
    159             ! land point on Bab el Mandeb zonal section 
     158      IF( cp_cfg == 'orca' ) THEN 
     159         IF( jp_cfg == 2 )   THEN       ! land point on Bab el Mandeb zonal section 
    160160            ij0 =  87   ;   ij1 =  88 
    161161            ii0 = 160   ;   ii1 = 161 
    … …  
    283283            DO ji = fs_2, fs_jpim1   ! vector opt. 
    284284               IF( fmask(ji,jj,jk) == 0. ) THEN 
    285                   fmask(ji,jj,jk) = shlat * MIN( 1., MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
    286                      &                                    zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     285                  fmask(ji,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     286                     &                                       zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
    287287               ENDIF 
    288288            END DO 
    … …  
    290290         DO jj = 2, jpjm1 
    291291            IF( fmask(1,jj,jk) == 0. ) THEN 
    292                fmask(1  ,jj,jk) = shlat * MIN( 1., MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     292               fmask(1  ,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
    293293            ENDIF 
    294294            IF( fmask(jpi,jj,jk) == 0. ) THEN 
    295                fmask(jpi,jj,jk) = shlat * MIN( 1., MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     295               fmask(jpi,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    296296            ENDIF 
    297297         END DO          
    298298         DO ji = 2, jpim1 
    299299            IF( fmask(ji,1,jk) == 0. ) THEN 
    300                fmask(ji, 1 ,jk) = shlat * MIN( 1., MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     300               fmask(ji, 1 ,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
    301301            ENDIF 
    302302            IF( fmask(ji,jpj,jk) == 0. ) THEN 
    303                fmask(ji,jpj,jk) = shlat * MIN( 1., MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     303               fmask(ji,jpj,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    304304            ENDIF 
    305305         END DO 

  • trunk/NEMO/OPA_SRC/DOM/domzgr.F90

    r1577 r1601  
    4242 
    4343!!gm   DOCTOR name for the namelist parameter... 
    44    !                                 !!! ** Namelist nam_zgr_sco ** 
    45    REAL(wp) ::   sbot_min =  300.     ! minimum depth of s-bottom surface (>0) (m) 
    46    REAL(wp) ::   sbot_max = 5250.     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
    47    REAL(wp) ::   theta    =    6.0    ! surface control parameter (0<=theta<=20) 
    48    REAL(wp) ::   thetb    =    0.75   ! bottom control parameter  (0<=thetb<= 1) 
    49    REAL(wp) ::   r_max    =    0.15   ! maximum cut-off r-value allowed (0<r_max<1) 
     44   !                                    !!! ** Namelist namzgr_sco ** 
     45   REAL(wp) ::   rn_sbot_min =  300.     ! minimum depth of s-bottom surface (>0) (m) 
     46   REAL(wp) ::   rn_sbot_max = 5250.     ! maximum depth of s-bottom surface (= ocean depth) (>0) (m) 
     47   REAL(wp) ::   rn_theta    =    6.0    ! surface control parameter (0<=rn_theta<=20) 
     48   REAL(wp) ::   rn_thetb    =    0.75   ! bottom control parameter  (0<=rn_thetb<= 1) 
     49   REAL(wp) ::   rn_rmax     =    0.15   ! maximum cut-off r-value allowed (0<rn_rmax<1) 
     50   LOGICAL  ::   ln_s_sigma  = .false.   ! use hybrid s-sigma -coordinate & stretching function fssig1 (ln_sco=T) 
     51   REAL(wp) ::   rn_bb       =    0.8    ! stretching parameter for song and haidvogel stretching 
     52   !                                     ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 
     53   REAL(wp) ::   rn_hc       = 150.      ! Critical depth for s-sigma coordinates 
    5054  
    5155   !! * Substitutions 
    … …  
    7983      INTEGER ::   ioptio = 0   ! temporary integer 
    8084      !! 
    81       NAMELIST/nam_zgr/ ln_zco, ln_zps, ln_sco 
    82       !!---------------------------------------------------------------------- 
    83  
    84       REWIND ( numnam )                ! Read Namelist nam_zgr : vertical coordinate' 
    85       READ   ( numnam, nam_zgr ) 
     85      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 
     86      !!---------------------------------------------------------------------- 
     87 
     88      REWIND ( numnam )                ! Read Namelist namzgr : vertical coordinate' 
     89      READ   ( numnam, namzgr ) 
    8690 
    8791      IF(lwp) THEN                     ! Control print 
    … …  
    8993         WRITE(numout,*) 'dom_zgr : vertical coordinate' 
    9094         WRITE(numout,*) '~~~~~~~' 
    91          WRITE(numout,*) '          Namelist nam_zgr : set vertical coordinate' 
     95         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate' 
    9296         WRITE(numout,*) '             z-coordinate - full steps      ln_zco = ', ln_zco 
    9397         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps = ', ln_zps 
    … …  
    232236      ENDIF 
    233237 
     238!!gm BUG in s-coordinate this does not work! 
    234239      ! deepest/shallowest W level Above/Bellow ~10m 
    235240      zrefdep = 10. - ( 0.1*MINVAL(e3w_0) )                          ! ref. depth with tolerance (10% of minimum layer thickness) 
    236241      nlb10 = MINLOC( gdepw_0, mask = gdepw_0 > zrefdep, dim = 1 )   ! shallowest W level Bellow ~10m 
    237242      nla10 = nlb10 - 1                                              ! deepest    W level Above  ~10m 
     243!!gm end bug 
    238244 
    239245      IF(lwp) THEN                        ! control print 
    … …  
    10011007      !!---------------------------------------------------------------------- 
    10021008      ! 
    1003       pf =   (   TANH( theta * ( -(pk-0.5) / REAL(jpkm1) + thetb )  )      & 
    1004          &     - TANH( thetb * theta                                )  )   & 
    1005          & * (   COSH( theta                           )                   & 
    1006          &     + COSH( theta * ( 2.e0 * thetb - 1.e0 ) )  )                & 
    1007          & / ( 2.e0 * SINH( theta ) ) 
     1009      pf =   (   TANH( rn_theta * ( -(pk-0.5) / REAL(jpkm1) + rn_thetb )  )      & 
     1010         &     - TANH( rn_thetb * rn_theta                                )  )   & 
     1011         & * (   COSH( rn_theta                           )                   & 
     1012         &     + COSH( rn_theta * ( 2.e0 * rn_thetb - 1.e0 ) )  )                & 
     1013         & / ( 2.e0 * SINH( rn_theta ) ) 
    10081014      ! 
    10091015   END FUNCTION fssig 
    10101016 
    10111017 
    1012    FUNCTION fssig1( pk1, bb ) RESULT( pf1 ) 
     1018   FUNCTION fssig1( pk1, pbb ) RESULT( pf1 ) 
    10131019      !!---------------------------------------------------------------------- 
    10141020      !!                 ***  ROUTINE eos_init  *** 
    … …  
    10241030      !!---------------------------------------------------------------------- 
    10251031      REAL(wp), INTENT(in   ) ::   pk1   ! continuous "k" coordinate 
    1026       REAL(wp), INTENT(in   ) ::   bb    ! Stretching coefficient 
     1032      REAL(wp), INTENT(in   ) ::   pbb   ! Stretching coefficient 
    10271033      REAL(wp)                ::   pf1   ! sigma value 
    10281034      !!---------------------------------------------------------------------- 
    10291035      ! 
    1030       IF ( theta == 0 ) then      ! uniform sigma 
     1036      IF ( rn_theta == 0 ) then      ! uniform sigma 
    10311037         pf1 = -(pk1-0.5) / REAL( jpkm1 ) 
    10321038      ELSE                        ! stretched sigma 
    1033          pf1 =   (1.0-bb) * (sinh( theta*(-(pk1-0.5)/REAL(jpkm1)) ) ) / sinh(theta) + & 
    1034             &    bb * ( (tanh( theta*( (-(pk1-0.5)/REAL(jpkm1)) + 0.5) ) - tanh(0.5*theta) ) / & 
    1035             &    (2*tanh(0.5*theta) ) ) 
     1039         pf1 =   (1.0-pbb) * (sinh( rn_theta*(-(pk1-0.5)/REAL(jpkm1)) ) ) / sinh(rn_theta) + & 
     1040            &    pbb * ( (tanh( rn_theta*( (-(pk1-0.5)/REAL(jpkm1)) + 0.5) ) - tanh(0.5*rn_theta) ) / & 
     1041            &    (2*tanh(0.5*rn_theta) ) ) 
    10361042      ENDIF 
    10371043      ! 
    … …  
    10771083      REAL(wp), DIMENSION(jpi,jpj) ::   zri , zrj , zhbat   !  -     - 
    10781084      !! 
    1079       LOGICAL  :: ln_s_sigma = .false. !use hybrid s_sigma coordinates & stretching function fssig1,used with ln_sco = .true. 
    1080       REAL(wp) :: bb = 0.8   ! stretching parameter for song and haidvogel stretching, bb=0; top only, bb =1; top and bottom 
    1081       REAL(wp) :: hc = 150   ! Critical depth for s-sigma coordinates 
    10821085!!gm never do that !!!!   ==> Pb at compilation phase on several computer 
    10831086      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   gsigw3 = 0.0d0 
    … …  
    10931096!!gm end 
    10941097      !! 
    1095       NAMELIST/nam_zgr_sco/ sbot_max, sbot_min, theta, thetb, r_max, ln_s_sigma, bb, hc 
    1096       !!---------------------------------------------------------------------- 
    1097  
    1098       REWIND( numnam )                        ! Read Namelist nam_zgr_sco : sigma-stretching parameters 
    1099       READ  ( numnam, nam_zgr_sco ) 
     1098      NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 
     1099      !!---------------------------------------------------------------------- 
     1100 
     1101      REWIND( numnam )                        ! Read Namelist namzgr_sco : sigma-stretching parameters 
     1102      READ  ( numnam, namzgr_sco ) 
    11001103 
    11011104      IF(lwp) THEN                            ! control print 
    … …  
    11031106         WRITE(numout,*) 'dom:zgr_sco : s-coordinate or hybrid z-s-coordinate' 
    11041107         WRITE(numout,*) '~~~~~~~~~~~' 
    1105          WRITE(numout,*) '         Namelist nam_zgr_sco' 
    1106          WRITE(numout,*) '            sigma-stretching coeffs ' 
    1107          WRITE(numout,*) '            maximum depth of s-bottom surface (>0)    sbot_max   = ' ,sbot_max 
    1108          WRITE(numout,*) '            minimum depth of s-bottom surface (>0)    sbot_min   = ' ,sbot_min 
    1109          WRITE(numout,*) '            surface control parameter (0<=theta<=20)  theta      = ', theta 
    1110          WRITE(numout,*) '            bottom control parameter  (0<=thetb<= 1)  thetb      = ', thetb 
    1111          WRITE(numout,*) '            maximum cut-off r-value allowed           r_max      = ' , r_max 
    1112          WRITE(numout,*) '            Critical depth                            hc         = ', hc 
    1113          WRITE(numout,*) '            Hybrid s-sigma-coordinate                 ln_s_sigma = ', ln_s_sigma 
    1114       ENDIF 
    1115  
    1116       hift(:,:) = sbot_min                     ! set the minimum depth for the s-coordinate 
    1117       hifu(:,:) = sbot_min 
    1118       hifv(:,:) = sbot_min 
    1119       hiff(:,:) = sbot_min 
     1108         WRITE(numout,*) '   Namelist namzgr_sco' 
     1109         WRITE(numout,*) '      sigma-stretching coeffs ' 
     1110         WRITE(numout,*) '      maximum depth of s-bottom surface (>0)       rn_sbot_max   = ' ,rn_sbot_max 
     1111         WRITE(numout,*) '      minimum depth of s-bottom surface (>0)       rn_sbot_min   = ' ,rn_sbot_min 
     1112         WRITE(numout,*) '      surface control parameter (0<=rn_theta<=20)  rn_theta      = ', rn_theta 
     1113         WRITE(numout,*) '      bottom  control parameter (0<=rn_thetb<= 1)  rn_thetb      = ', rn_thetb 
     1114         WRITE(numout,*) '      maximum cut-off r-value allowed              rn_rmax       = ', rn_rmax 
     1115         WRITE(numout,*) '      Hybrid s-sigma-coordinate                    ln_s_sigma    = ', ln_s_sigma 
     1116         WRITE(numout,*) '      stretching parameter (song and haidvogel)    rn_bb         = ', rn_bb 
     1117         WRITE(numout,*) '      Critical depth                               rn_hc         = ', rn_hc 
     1118      ENDIF 
     1119 
     1120      hift(:,:) = rn_sbot_min                     ! set the minimum depth for the s-coordinate 
     1121      hifu(:,:) = rn_sbot_min 
     1122      hifv(:,:) = rn_sbot_min 
     1123      hiff(:,:) = rn_sbot_min 
    11201124 
    11211125      !                                        ! set maximum ocean depth 
    1122       bathy(:,:) = MIN( sbot_max, bathy(:,:) ) 
     1126      bathy(:,:) = MIN( rn_sbot_max, bathy(:,:) ) 
    11231127 
    11241128      DO jj = 1, jpj 
    11251129         DO ji = 1, jpi 
    11261130           IF (bathy(ji,jj) .gt. 0.0) THEN 
    1127               bathy(ji,jj) = MAX( sbot_min, bathy(ji,jj) ) 
     1131              bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 
    11281132           ENDIF 
    11291133         END DO 
    … …  
    11391143      DO jj = 1, jpj 
    11401144         DO ji = 1, jpi 
    1141             zenv(ji,jj) = MAX( bathy(ji,jj), sbot_min ) 
     1145            zenv(ji,jj) = MAX( bathy(ji,jj), rn_sbot_min ) 
    11421146         END DO 
    11431147      END DO 
    … …  
    11451149      zrmax = 1.e0 
    11461150      !                                                     ! ================ ! 
    1147       DO WHILE ( jl <= 10000 .AND. zrmax > r_max )          !  Iterative loop  ! 
     1151      DO WHILE ( jl <= 10000 .AND. zrmax > rn_rmax )          !  Iterative loop  ! 
    11481152         !                                                  ! ================ ! 
    11491153         jl = jl + 1 
    … …  
    11571161               zrj(ji,jj) = ABS( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) ) 
    11581162               zrmax = MAX( zrmax, zri(ji,jj), zrj(ji,jj) ) 
    1159                IF( zri(ji,jj) > r_max )   zmsk(ji  ,jj  ) = 1.0 
    1160                IF( zri(ji,jj) > r_max )   zmsk(iip1,jj  ) = 1.0 
    1161                IF( zrj(ji,jj) > r_max )   zmsk(ji  ,jj  ) = 1.0 
    1162                IF( zrj(ji,jj) > r_max )   zmsk(ji  ,ijp1) = 1.0 
     1163               IF( zri(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1.0 
     1164               IF( zri(ji,jj) > rn_rmax )   zmsk(iip1,jj  ) = 1.0 
     1165               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,jj  ) = 1.0 
     1166               IF( zrj(ji,jj) > rn_rmax )   zmsk(ji  ,ijp1) = 1.0 
    11631167            END DO 
    11641168         END DO 
    … …  
    12181222            DO ji = 1, jpi 
    12191223               ztaper = EXP( -(gphit(ji,jj)/8)**2 ) 
    1220                hbatt(ji,jj) = sbot_max * ztaper + hbatt(ji,jj) * (1.-ztaper) 
     1224               hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * (1.-ztaper) 
    12211225            END DO 
    12221226         END DO 
    … …  
    12391243      IF(lwp) THEN 
    12401244         WRITE(numout,*) 
    1241          WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', sbot_min 
    1242       ENDIF 
    1243       hbatu(:,:) = sbot_min 
    1244       hbatv(:,:) = sbot_min 
    1245       hbatf(:,:) = sbot_min 
     1245         WRITE(numout,*) ' zgr_sco: minimum depth of the envelop topography set to : ', rn_sbot_min 
     1246      ENDIF 
     1247      hbatu(:,:) = rn_sbot_min 
     1248      hbatv(:,:) = rn_sbot_min 
     1249      hbatf(:,:) = rn_sbot_min 
    12461250      DO jj = 1, jpjm1 
    12471251        DO ji = 1, jpim1 
    … …  
    12591263         DO ji = 1, jpi 
    12601264            IF( hbatu(ji,jj) == 0.e0 ) THEN 
    1261                IF( zhbat(ji,jj) == 0.e0 )   hbatu(ji,jj) = sbot_min 
     1265               IF( zhbat(ji,jj) == 0.e0 )   hbatu(ji,jj) = rn_sbot_min 
    12621266               IF( zhbat(ji,jj) /= 0.e0 )   hbatu(ji,jj) = zhbat(ji,jj) 
    12631267            ENDIF 
    … …  
    12681272         DO ji = 1, jpi 
    12691273            IF( hbatv(ji,jj) == 0.e0 ) THEN 
    1270                IF( zhbat(ji,jj) == 0.e0 )   hbatv(ji,jj) = sbot_min 
     1274               IF( zhbat(ji,jj) == 0.e0 )   hbatv(ji,jj) = rn_sbot_min 
    12711275               IF( zhbat(ji,jj) /= 0.e0 )   hbatv(ji,jj) = zhbat(ji,jj) 
    12721276            ENDIF 
    … …  
    12771281         DO ji = 1, jpi 
    12781282            IF( hbatf(ji,jj) == 0.e0 ) THEN 
    1279                IF( zhbat(ji,jj) == 0.e0 )   hbatf(ji,jj) = sbot_min 
     1283               IF( zhbat(ji,jj) == 0.e0 )   hbatf(ji,jj) = rn_sbot_min 
    12801284               IF( zhbat(ji,jj) /= 0.e0 )   hbatf(ji,jj) = zhbat(ji,jj) 
    12811285            ENDIF 
    … …  
    13071311      ! non-dimensional "sigma" for model level depth at w- and t-levels 
    13081312 
    1309       IF ( ln_s_sigma ) THEN  !Song and Haidvogel style stretched sigma for depths below hc, with uniform sigma in shallower waters 
    1310  
    1311          DO ji=1,jpi 
    1312            DO jj=1,jpj 
    1313  
    1314              IF (hbatt(ji,jj).GT.hc) THEN !deep water, stretched sigma 
     1313      IF( ln_s_sigma ) THEN        ! Song and Haidvogel style stretched sigma for depths 
     1314         !                         ! below rn_hc, with uniform sigma in shallower waters 
     1315         DO ji = 1, jpi 
     1316            DO jj = 1, jpj 
     1317 
     1318             IF (hbatt(ji,jj).GT.rn_hc) THEN !deep water, stretched sigma 
    13151319               DO jk = 1, jpk 
    1316                   gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, bb ) 
    1317                   gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , bb ) 
     1320                  gsigw3(ji,jj,jk) = -fssig1( REAL(jk,wp)-0.5_wp, rn_bb ) 
     1321                  gsigt3(ji,jj,jk) = -fssig1( REAL(jk,wp)       , rn_bb ) 
    13181322               END DO 
    13191323             ELSE ! shallow water, uniform sigma 
    … …  
    13421346                zcoeft = ( REAL(jk,wp) - 0.5 ) / REAL(jpkm1,wp) 
    13431347                zcoefw = ( REAL(jk,wp) - 1.0 ) / REAL(jpkm1,wp) 
    1344                 gdept (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-hc)*gsigt3(ji,jj,jk)+hc*zcoeft) 
    1345                 gdepw (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-hc)*gsigw3(ji,jj,jk)+hc*zcoefw) 
    1346                 gdep3w(ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-hc)*gsi3w3(ji,jj,jk)+hc*zcoefw) 
     1348                gdept (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsigt3(ji,jj,jk)+rn_hc*zcoeft) 
     1349                gdepw (ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsigw3(ji,jj,jk)+rn_hc*zcoefw) 
     1350                gdep3w(ji,jj,jk) = (scosrf(ji,jj)+(hbatt(ji,jj)-rn_hc)*gsi3w3(ji,jj,jk)+rn_hc*zcoefw) 
    13471351             END DO 
    13481352 
    … …  
    13671371                                   ( hbatt(ji,jj)+hbatt(ji,jj+1) ) 
    13681372 
    1369                 e3t(ji,jj,jk)=((hbatt(ji,jj)-hc)*esigt3(ji,jj,jk) + hc/FLOAT(jpkm1)) 
    1370                 e3u(ji,jj,jk)=((hbatu(ji,jj)-hc)*esigtu3(ji,jj,jk) + hc/FLOAT(jpkm1)) 
    1371                 e3v(ji,jj,jk)=((hbatv(ji,jj)-hc)*esigtv3(ji,jj,jk) + hc/FLOAT(jpkm1)) 
    1372                 e3f(ji,jj,jk)=((hbatf(ji,jj)-hc)*esigtf3(ji,jj,jk) + hc/FLOAT(jpkm1)) 
     1373                e3t(ji,jj,jk)=((hbatt(ji,jj)-rn_hc)*esigt3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
     1374                e3u(ji,jj,jk)=((hbatu(ji,jj)-rn_hc)*esigtu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
     1375                e3v(ji,jj,jk)=((hbatv(ji,jj)-rn_hc)*esigtv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
     1376                e3f(ji,jj,jk)=((hbatf(ji,jj)-rn_hc)*esigtf3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    13731377                ! 
    1374                 e3w (ji,jj,jk)=((hbatt(ji,jj)-hc)*esigw3(ji,jj,jk) + hc/FLOAT(jpkm1)) 
    1375                 e3uw(ji,jj,jk)=((hbatu(ji,jj)-hc)*esigwu3(ji,jj,jk) + hc/FLOAT(jpkm1)) 
    1376                 e3vw(ji,jj,jk)=((hbatv(ji,jj)-hc)*esigwv3(ji,jj,jk) + hc/FLOAT(jpkm1)) 
     1378                e3w (ji,jj,jk)=((hbatt(ji,jj)-rn_hc)*esigw3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
     1379                e3uw(ji,jj,jk)=((hbatu(ji,jj)-rn_hc)*esigwu3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
     1380                e3vw(ji,jj,jk)=((hbatv(ji,jj)-rn_hc)*esigwv3(ji,jj,jk) + rn_hc/FLOAT(jpkm1)) 
    13771381             END DO 
    13781382 

  • trunk/NEMO/OPA_SRC/DYN/dynadv.F90

    r1152 r1601  
    8686      INTEGER ::   ioptio 
    8787 
    88       NAMELIST/nam_dynadv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs 
     88      NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs 
    8989      !!---------------------------------------------------------------------- 
    9090 
    91       REWIND ( numnam )               ! Read Namelist nam_dynadv : momentum advection scheme 
    92       READ   ( numnam, nam_dynadv ) 
     91      REWIND ( numnam )               ! Read Namelist namdyn_adv : momentum advection scheme 
     92      READ   ( numnam, namdyn_adv ) 
    9393 
    9494      IF(lwp) THEN                    ! Namelist print 
    … …  
    9696         WRITE(numout,*) 'dyn_adv_ctl : choice/control of the momentum advection scheme' 
    9797         WRITE(numout,*) '~~~~~~~~~~~' 
    98          WRITE(numout,*) '       Namelist nam_dynadv : chose a advection formulation & scheme for momentum' 
     98         WRITE(numout,*) '       Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 
    9999         WRITE(numout,*) '          Vector/flux form (T/F)             ln_dynadv_vec  = ', ln_dynadv_vec 
    100100         WRITE(numout,*) '          2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2 
    … …  
    108108      IF( lk_esopa       )   ioptio =          1 
    109109 
    110       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist nam_dynadv' ) 
     110      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' ) 
    111111 
    112112      !                               ! Set nadv 

  • trunk/NEMO/OPA_SRC/DYN/dynhpg.F90

    r1152 r1601  
    4141   PUBLIC   dyn_hpg    ! routine called by step module 
    4242 
    43    !!* Namelist nam_dynhpg : Choice of horizontal pressure gradient computation 
    44    LOGICAL  ::   ln_hpg_zco = .TRUE.    ! z-coordinate - full steps 
    45    LOGICAL  ::   ln_hpg_zps = .FALSE.   ! z-coordinate - partial steps (interpolation) 
    46    LOGICAL  ::   ln_hpg_sco = .FALSE.   ! s-coordinate (standard jacobian formulation) 
    47    LOGICAL  ::   ln_hpg_hel = .FALSE.   ! s-coordinate (helsinki modification) 
    48    LOGICAL  ::   ln_hpg_wdj = .FALSE.   ! s-coordinate (weighted density jacobian) 
    49    LOGICAL  ::   ln_hpg_djc = .FALSE.   ! s-coordinate (Density Jacobian with Cubic polynomial) 
    50    LOGICAL  ::   ln_hpg_rot = .FALSE.   ! s-coordinate (ROTated axes scheme) 
    51    REAL(wp) ::   gamm       = 0.e0      ! weighting coefficient 
    52  
    53    INTEGER  ::   nhpg  =  0             ! = 0 to 6, type of pressure gradient scheme used 
    54       !                                 ! (deduced from ln_hpg_... flags) 
     43   !                                              !!* Namelist namdyn_hpg : hydrostatic pressure gradient  
     44   LOGICAL , PUBLIC ::   ln_hpg_zco    = .TRUE.    !: z-coordinate - full steps 
     45   LOGICAL , PUBLIC ::   ln_hpg_zps    = .FALSE.   !: z-coordinate - partial steps (interpolation) 
     46   LOGICAL , PUBLIC ::   ln_hpg_sco    = .FALSE.   !: s-coordinate (standard jacobian formulation) 
     47   LOGICAL , PUBLIC ::   ln_hpg_hel    = .FALSE.   !: s-coordinate (helsinki modification) 
     48   LOGICAL , PUBLIC ::   ln_hpg_wdj    = .FALSE.   !: s-coordinate (weighted density jacobian) 
     49   LOGICAL , PUBLIC ::   ln_hpg_djc    = .FALSE.   !: s-coordinate (Density Jacobian with Cubic polynomial) 
     50   LOGICAL , PUBLIC ::   ln_hpg_rot    = .FALSE.   !: s-coordinate (ROTated axes scheme) 
     51   REAL(wp), PUBLIC ::   rn_gamma      = 0.e0      !: weighting coefficient 
     52   LOGICAL , PUBLIC ::   ln_dynhpg_imp = .FALSE.   !: semi-implicite hpg flag 
     53   INTEGER , PUBLIC ::   nn_dynhpg_rst = 0         !: add dynhpg implicit variables in restart ot not 
     54 
     55   INTEGER  ::   nhpg  =  0   ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 
    5556 
    5657   !! * Substitutions 
    … …  
    116117      !!              computation and consistency control 
    117118      !! 
    118       !! ** Action  :   Read the namelist namdynhpg and check the consistency 
     119      !! ** Action  :   Read the namelist namdyn_hpg and check the consistency 
    119120      !!      with the type of vertical coordinate used (zco, zps, sco) 
    120121      !!---------------------------------------------------------------------- 
    121122      INTEGER ::   ioptio = 0      ! temporary integer 
    122  
    123       NAMELIST/nam_dynhpg/ ln_hpg_zco, ln_hpg_zps, ln_hpg_sco, ln_hpg_hel,   & 
    124          &                 ln_hpg_wdj, ln_hpg_djc, ln_hpg_rot, gamm 
    125       !!---------------------------------------------------------------------- 
    126  
    127       REWIND ( numnam )               ! Read Namelist nam_dynhpg : pressure gradient calculation options 
    128       READ   ( numnam, nam_dynhpg ) 
     123      !! 
     124!     NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   & 
     125!        &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   & 
     126!        &                 ln_dynhpg_imp, nn_dynhpg_rst 
     127      !!---------------------------------------------------------------------- 
     128 
     129!     REWIND ( numnam )               ! Namelist namdyn_hpg : already read in opa.F90 module 
     130!     READ   ( numnam, namdyn_hpg ) 
    129131 
    130132      IF(lwp) THEN                    ! Control print 
    131133         WRITE(numout,*) 
    132          WRITE(numout,*) 'dyn:hpg_ctl : hydrostatic pressure gradient control' 
    133          WRITE(numout,*) '~~~~~~~~~~~' 
    134          WRITE(numout,*) '       Namelist nam_dynhpg : choice of hpg scheme' 
    135          WRITE(numout,*) '          z-coord. - full steps                          ln_hpg_zco = ', ln_hpg_zco 
    136          WRITE(numout,*) '          z-coord. - partial steps (interpolation)       ln_hpg_zps = ', ln_hpg_zps 
    137          WRITE(numout,*) '          s-coord. (standard jacobian formulation)       ln_hpg_sco = ', ln_hpg_sco 
    138          WRITE(numout,*) '          s-coord. (helsinki modification)               ln_hpg_hel = ', ln_hpg_hel 
    139          WRITE(numout,*) '          s-coord. (weighted density jacobian)           ln_hpg_wdj = ', ln_hpg_wdj 
    140          WRITE(numout,*) '          s-coord. (Density Jacobian: Cubic polynomial)  ln_hpg_djc = ', ln_hpg_djc 
    141          WRITE(numout,*) '          s-coord. (ROTated axes scheme)                 ln_hpg_rot = ', ln_hpg_rot 
    142          WRITE(numout,*) '          weighting coeff. (wdj scheme)                     gamm       = ', gamm 
     134         WRITE(numout,*) 'dyn_hpg : hydrostatic pressure gradient' 
     135         WRITE(numout,*) '~~~~~~~' 
     136         WRITE(numout,*) '   Namelist namdyn_hpg : choice of hpg scheme' 
     137         WRITE(numout,*) '      z-coord. - full steps                             ln_hpg_zco    = ', ln_hpg_zco 
     138         WRITE(numout,*) '      z-coord. - partial steps (interpolation)          ln_hpg_zps    = ', ln_hpg_zps 
     139         WRITE(numout,*) '      s-coord. (standard jacobian formulation)          ln_hpg_sco    = ', ln_hpg_sco 
     140         WRITE(numout,*) '      s-coord. (helsinki modification)                  ln_hpg_hel    = ', ln_hpg_hel 
     141         WRITE(numout,*) '      s-coord. (weighted density jacobian)              ln_hpg_wdj    = ', ln_hpg_wdj 
     142         WRITE(numout,*) '      s-coord. (Density Jacobian: Cubic polynomial)     ln_hpg_djc    = ', ln_hpg_djc 
     143         WRITE(numout,*) '      s-coord. (ROTated axes scheme)                    ln_hpg_rot    = ', ln_hpg_rot 
     144         WRITE(numout,*) '      weighting coeff. (wdj scheme)                     rn_gamma      = ', rn_gamma 
     145         WRITE(numout,*) '      time stepping: centered (F) or semi-implicit (T)  ln_dynhpg_imp = ', ln_dynhpg_imp 
     146         WRITE(numout,*) '      add in restart dynhpg semi-implicit variable      nn_dynhpg_rst = ', nn_dynhpg_rst 
    143147      ENDIF 
     148 
     149      IF( .NOT. ln_dynhpg_imp )   nn_dynhpg_rst = 0      ! force no adding dynhpg implicit variables in restart 
    144150 
    145151      IF( lk_vvl .AND. .NOT. ln_hpg_sco )   THEN 
    … …  
    517523      !! 
    518524      !! ** Method  :   Weighted Density Jacobian (wdj) scheme (song 1998) 
    519       !!      The weighting coefficients from the namelist parameter gamm 
    520       !!      (alpha=0.5-gamm ; beta=1-alpha=0.5+gamm) 
     525      !!      The weighting coefficients from the namelist parameter rn_gamma 
     526      !!      (alpha=0.5-rn_gamma ; beta=1-alpha=0.5+rn_gamma 
    521527      !! 
    522528      !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    … …  
    540546      ! Local constant initialization 
    541547      zcoef0 = - grav * 0.5 
    542       zalph  = 0.5 - gamm        ! weighting coefficients (alpha=0.5-gamm) 
    543       zbeta  = 0.5 + gamm        !                        (beta =1-alpha=0.5+gamm) 
     548      zalph  = 0.5 - rn_gamma    ! weighting coefficients (alpha=0.5-rn_gamma 
     549      zbeta  = 0.5 + rn_gamma    !                        (beta =1-alpha=0.5+rn_gamma 
    544550 
    545551      ! Surface value (no ponderation) 

  • trunk/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r1556 r1601  
    1818   !!   'key_dynspg_flt'                              filtered free surface 
    1919   !!---------------------------------------------------------------------- 
    20    !!   dyn_spg_flt  : update the momentum trend with the surface pressure 
    21    !!                  gradient in the filtered free surface case with 
    22    !!                  vector optimization 
     20   !!   dyn_spg_flt  : update the momentum trend with the surface pressure gradient in the filtered free surface case  
    2321   !!   flt_rst      : read/write the time-splitting restart fields in the ocean restart file 
    2422   !!---------------------------------------------------------------------- 
    … …  
    3129   USE phycst          ! physical constants 
    3230   USE domvvl          ! variable volume 
     31   USE solmat          ! matrix construction for elliptic solvers 
    3332   USE solver          ! solver initialization 
    3433   USE solpcg          ! preconditionned conjugate gradient solver 
    … …  
    4443   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    4544   USE prtctl          ! Print control 
    46    USE solmat          ! matrix construction for elliptic solvers 
    4745   USE agrif_opa_interp 
    4846   USE iom 
    … …  
    7674      !! ** Method  :   Filtered free surface formulation. The surface 
    7775      !!      pressure gradient is given by: 
    78       !!         spgu = 1/rau0 d/dx(ps) =  1/e1u di( sshn + rnu btda ) 
    79       !!         spgv = 1/rau0 d/dy(ps) =  1/e2v dj( sshn + rnu btda ) 
     76      !!         spgu = 1/rau0 d/dx(ps) =  1/e1u di( sshn + btda ) 
     77      !!         spgv = 1/rau0 d/dy(ps) =  1/e2v dj( sshn + btda ) 
    8078      !!      where sshn is the free surface elevation and btda is the after 
    8179      !!      time derivative of the free surface elevation 
    … …  
    106104      USE oce, ONLY :   zvb   => sa   ! ta used as workspace 
    107105      !! 
    108       INTEGER, INTENT( in ) ::   kt       ! ocean time-step index 
    109       INTEGER, INTENT( out ) ::   kindic   ! solver convergence flag (<0 if not converge) 
     106      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
     107      INTEGER, INTENT(  out) ::   kindic   ! solver convergence flag (<0 if not converge) 
    110108      !!                                    
    111       INTEGER  ::   ji, jj, jk                          ! dummy loop indices 
    112       REAL(wp) ::   z2dt, z2dtg, zraur, znugdt          ! temporary scalars 
    113       REAL(wp) ::   znurau, zgcb, zbtd                  !   "          " 
    114       REAL(wp) ::   ztdgu, ztdgv                        !   "          " 
     109      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
     110      REAL(wp) ::   z2dt, z2dtg, zraur   ! temporary scalars 
     111      REAL(wp) ::   zgcb, zbtd   !   -          - 
     112      REAL(wp) ::   ztdgu, ztdgv         !   -          - 
    115113      !!---------------------------------------------------------------------- 
    116114      ! 
    … …  
    127125         ! read filtered free surface arrays in restart file 
    128126         ! when using agrif, sshn, gcx have to be read in istate 
    129          IF (.NOT. lk_agrif) CALL flt_rst( nit000, 'READ' )       ! read or initialize the following fields: 
     127         IF(.NOT. lk_agrif)   CALL flt_rst( nit000, 'READ' )      ! read or initialize the following fields: 
    130128         !                                                        ! gcx, gcxb 
    131129      ENDIF 
    132130 
    133131      ! Local constant initialization 
    134       z2dt = 2. * rdt                                       ! time step: leap-frog 
    135       IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt       ! time step: Euler if restart from rest 
    136       IF( neuler == 0 .AND. kt == nit000+1 ) CALL sol_mat(kt) 
     132      z2dt = 2. * rdt                                             ! time step: leap-frog 
     133      IF( neuler == 0 .AND. kt == nit000   )   z2dt = rdt         ! time step: Euler if restart from rest 
     134      IF( neuler == 0 .AND. kt == nit000+1 )   CALL sol_mat( kt ) 
    137135      z2dtg  = grav * z2dt 
    138136      zraur  = 1. / rauw 
    139       znugdt =  rnu * grav * z2dt 
    140       znurau =  znugdt * zraur 
    141137 
    142138      !! Explicit physics with thickness weighted updates 
    … …  
    237233         END DO 
    238234      END DO 
    239  
    240       ! Boundary conditions on (spgu,spgv) 
    241       CALL lbc_lnk( spgu, 'U', -1. ) 
     235      CALL lbc_lnk( spgu, 'U', -1. )       ! lateral boundary conditions  
    242236      CALL lbc_lnk( spgv, 'V', -1. ) 
    243237 
    … …  
    245239 
    246240      ! Right hand side of the elliptic equation and first guess 
    247       ! ----------------------------------------------------------- 
     241      ! -------------------------------------------------------- 
    248242      DO jj = 2, jpjm1 
    249243         DO ji = fs_2, fs_jpim1   ! vector opt. 
    … …  
    259253      END DO 
    260254      ! applied the lateral boundary conditions 
    261       IF( nsolv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 ) CALL lbc_lnk_e( gcb, c_solver_pt, 1. )    
     255      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 )  CALL lbc_lnk_e( gcb, c_solver_pt, 1. )    
    262256 
    263257#if defined key_agrif 
    … …  
    265259         ! add contribution of gradient of after barotropic transport divergence  
    266260         IF( nbondi == -1 .OR. nbondi == 2 )   gcb(3     ,:) =   & 
    267             &    gcb(3     ,:) - znugdt * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu(2     ,:) * e2u(2     ,:) 
     261            &    gcb(3     ,:) - z2dtg * z2dt * laplacu(2     ,:) * gcdprc(3     ,:) * hu(2     ,:) * e2u(2     ,:) 
    268262         IF( nbondi ==  1 .OR. nbondi == 2 )   gcb(nlci-2,:) =   & 
    269             &    gcb(nlci-2,:) + znugdt * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:) 
     263            &    gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:) 
    270264         IF( nbondj == -1 .OR. nbondj == 2 )   gcb(:     ,3) =   & 
    271             &    gcb(:,3     ) - znugdt * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv(:,2     ) * e1v(:,2     ) 
     265            &    gcb(:,3     ) - z2dtg * z2dt * laplacv(:,2     ) * gcdprc(:,3     ) * hv(:,2     ) * e1v(:,2     ) 
    272266         IF( nbondj ==  1 .OR. nbondj == 2 )   gcb(:,nlcj-2) =   & 
    273             &    gcb(:,nlcj-2) + znugdt * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2) 
     267            &    gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2) 
    274268      ENDIF 
    275269#endif 
    … …  
    298292      kindic = 0 
    299293      IF( ncut == 0 ) THEN 
    300          IF( nsolv == 1 ) THEN         ! diagonal preconditioned conjuguate gradient 
    301             CALL sol_pcg( kindic ) 
    302          ELSEIF( nsolv == 2 ) THEN     ! successive-over-relaxation 
    303             CALL sol_sor( kindic ) 
    304          ELSE                          ! e r r o r in nsolv namelist parameter 
    305             WRITE(ctmp1,*) ' ~~~~~~~~~~~                not = ', nsolv 
    306             CALL ctl_stop( ' dyn_spg_flt : e r r o r, nsolv = 1 or 2', ctmp1 ) 
     294         IF    ( nn_solv == 1 ) THEN   ;   CALL sol_pcg( kindic )      ! diagonal preconditioned conjuguate gradient 
     295         ELSEIF( nn_solv == 2 ) THEN   ;   CALL sol_sor( kindic )      ! successive-over-relaxation 
    307296         ENDIF 
    308297      ENDIF 
    … …  
    313302         DO ji = fs_2, fs_jpim1   ! vector opt. 
    314303            ! trend of Transport divergence gradient 
    315             ztdgu = znugdt * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj) 
    316             ztdgv = znugdt * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj) 
     304            ztdgu = z2dtg * (gcx(ji+1,jj  ) - gcx(ji,jj) ) / e1u(ji,jj) 
     305            ztdgv = z2dtg * (gcx(ji  ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj) 
    317306            ! multiplied by z2dt 
    318307#if defined key_obc 
    … …  
    336325      IF( .NOT. Agrif_Root() ) THEN 
    337326         ! caution : grad D (fine) = grad D (coarse) at coarse/fine interface 
    338          IF( nbondi == -1 .OR. nbondi == 2 ) spgu(2     ,:) = znugdt * z2dt * laplacu(2     ,:) * umask(2     ,:,1) 
    339          IF( nbondi ==  1 .OR. nbondi == 2 ) spgu(nlci-2,:) = znugdt * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1) 
    340          IF( nbondj == -1 .OR. nbondj == 2 ) spgv(:,2     ) = znugdt * z2dt * laplacv(:,2     ) * vmask(:     ,2,1) 
    341          IF( nbondj ==  1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = znugdt * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1) 
     327         IF( nbondi == -1 .OR. nbondi == 2 ) spgu(2     ,:) = z2dtg * z2dt * laplacu(2     ,:) * umask(2     ,:,1) 
     328         IF( nbondi ==  1 .OR. nbondi == 2 ) spgu(nlci-2,:) = z2dtg * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1) 
     329         IF( nbondj == -1 .OR. nbondj == 2 ) spgv(:,2     ) = z2dtg * z2dt * laplacv(:,2     ) * vmask(:     ,2,1) 
     330         IF( nbondj ==  1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = z2dtg * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1) 
    342331      ENDIF 
    343332#endif       

  • trunk/NEMO/OPA_SRC/DYN/dynvor.F90

    r1516 r1601  
    3838   PUBLIC   dyn_vor   ! routine called by step.F90 
    3939 
    40    !                                             !!* Namelist nam_dynvor: vorticity term 
     40   !                                             !!* Namelist namdyn_vor: vorticity term 
    4141   LOGICAL, PUBLIC ::   ln_dynvor_ene = .FALSE.   !: energy conserving scheme 
    4242   LOGICAL, PUBLIC ::   ln_dynvor_ens = .TRUE.    !: enstrophy conserving scheme 
    … …  
    645645      !!---------------------------------------------------------------------- 
    646646      INTEGER ::   ioptio          ! temporary integer 
    647       NAMELIST/nam_dynvor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 
    648       !!---------------------------------------------------------------------- 
    649  
    650       REWIND ( numnam )               ! Read Namelist nam_dynvor : Vorticity scheme options 
    651       READ   ( numnam, nam_dynvor ) 
     647      NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een 
     648      !!---------------------------------------------------------------------- 
     649 
     650      REWIND ( numnam )               ! Read Namelist namdyn_vor : Vorticity scheme options 
     651      READ   ( numnam, namdyn_vor ) 
    652652 
    653653      IF(lwp) THEN                    ! Namelist print 
    … …  
    655655         WRITE(numout,*) 'dyn:vor_ctl : vorticity term : read namelist and control the consistency' 
    656656         WRITE(numout,*) '~~~~~~~~~~~' 
    657          WRITE(numout,*) '        Namelist nam_dynvor : oice of the vorticity term scheme' 
     657         WRITE(numout,*) '        Namelist namdyn_vor : oice of the vorticity term scheme' 
    658658         WRITE(numout,*) '           energy    conserving scheme                ln_dynvor_ene = ', ln_dynvor_ene 
    659659         WRITE(numout,*) '           enstrophy conserving scheme                ln_dynvor_ens = ', ln_dynvor_ens 

  • trunk/NEMO/OPA_SRC/FLO/flo_oce.F90

    r1152 r1601  
    22   !!====================================================================== 
    33   !!                     ***  MODULE flo_oce  *** 
    4    !!                 
    5    !! ** Purpose : - Define in memory all floats parameters and variables 
    6    !! 
    7    !! History : 
    8    !!   8.0  !  99-10  (CLIPPER projet) 
    9    !!   9.0  !  02-11  (G. Madec, A. Bozec)  F90: Free form and module 
     4   !! lagrangian floats :   define in memory all floats parameters and variables 
    105   !!====================================================================== 
    11    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    12    !! $Id$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     6   !! History :   OPA  ! 1999-10  (CLIPPER projet) 
     7   !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module 
    148   !!---------------------------------------------------------------------- 
    159#if   defined key_floats   ||   defined key_esopa 
    … …  
    1711   !!   'key_floats'                                        drifting floats 
    1812   !!---------------------------------------------------------------------- 
    19    !! * Modules used 
    2013   USE par_oce         ! ocean parameters 
    2114 
    2215   IMPLICIT NONE 
     16   PUBLIC 
    2317 
    2418   LOGICAL, PUBLIC, PARAMETER ::   lk_floats = .TRUE.    !: float flag 
    … …  
    2620   !! float parameters 
    2721   !! ---------------- 
    28    INTEGER, PARAMETER ::   & 
    29       jpnfl     = 23 ,            &  ! total number of floats during the run 
    30       jpnnewflo =  0 ,            &  ! number of floats added in a new run 
    31       jpnrstflo = jpnfl-jpnnewflo    ! number of floats for the restart 
     22   INTEGER, PUBLIC, PARAMETER ::   jpnfl     = 23 ,                !: total number of floats during the run 
     23   INTEGER, PUBLIC, PARAMETER ::   jpnnewflo =  0 ,                !: number of floats added in a new run 
     24   INTEGER, PUBLIC, PARAMETER ::   jpnrstflo = jpnfl - jpnnewflo   !: number of floats for the restart 
    3225 
    3326   !! float variables 
    3427   !! --------------- 
    35    INTEGER, DIMENSION(jpnfl)  ::    & 
    36       nisobfl,    &  ! 0 for a isobar float 
    37       !              ! 1 for a float following the w velocity 
    38       ngrpfl         ! number to identify searcher group 
     28   INTEGER, PUBLIC, DIMENSION(jpnfl)  ::   nisobfl   !: =0 for a isobar float , =1 for a float following the w velocity 
     29   INTEGER, PUBLIC, DIMENSION(jpnfl)  ::   ngrpfl    !: number to identify searcher group 
    3930 
    40    REAL(wp), DIMENSION(jpnfl) ::    & 
    41       flxx,       &  ! longitude of float (decimal degree) 
    42       flyy,       &  ! latitude of float (decimal degree) 
    43       flzz,       &  ! depth of float (m, positive) 
    44       tpifl,      &  ! index of float position on zonal axe 
    45       tpjfl,      &  ! index of float position on meridien axe 
    46       tpkfl          ! index of float position on z axe 
     31   REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   flxx , flyy , flzz    !: longitude, latitude, depth of float (decimal degree, m >0) 
     32   REAL(wp), PUBLIC, DIMENSION(jpnfl) ::   tpifl, tpjfl, tpkfl   !: (i,j,k) indices of float position 
     33 
     34   REAL(wp), PUBLIC, DIMENSION(jpi, jpj, jpk) ::   wb            !: vertical velocity at previous time step (m s-1). 
    4735    
    48    REAL(wp), DIMENSION(jpi, jpj, jpk) ::    &  
    49       wb             ! vertical velocity at previous time step (m s-1). 
    50     
    51    ! floats unit 
    52     
    53    LOGICAL  ::                & !!! * namelist namflo * 
    54       ln_rstflo = .FALSE. ,   &  ! T/F float restart  
    55       ln_argo   = .FALSE. ,   &  ! T/F argo type floats 
    56       ln_flork4 = .FALSE.        ! T/F 4th order Runge-Kutta 
    57    INTEGER  ::               & !!! * namelist namflo * 
    58       nwritefl,              &  ! frequency of float output file  
    59       nstockfl                  ! frequency of float restart file 
     36   !                                  !!! * namelist namflo : langrangian floats * 
     37   LOGICAL, PUBLIC  ::   ln_rstflo  = .FALSE.    !: T/F float restart  
     38   LOGICAL, PUBLIC  ::   ln_argo    = .FALSE.    !: T/F argo type floats 
     39   LOGICAL, PUBLIC  ::   ln_flork4  = .FALSE.    !: T/F 4th order Runge-Kutta 
     40   INTEGER, PUBLIC  ::   nn_writefl = 150       !: frequency of float output file  
     41   INTEGER, PUBLIC  ::   nn_stockfl = 450       !: frequency of float restart file 
    6042 
    6143#else 
    … …  
    6648#endif 
    6749 
     50   !!---------------------------------------------------------------------- 
     51   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     52   !! $Id$  
     53   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    6854   !!====================================================================== 
    6955END MODULE flo_oce 

  • trunk/NEMO/OPA_SRC/FLO/floats.F90

    r1152 r1601  
    44   !! Ocean floats : floats 
    55   !!====================================================================== 
     6   !! History :  OPA  !          (CLIPPER)   original Code 
     7   !!   NEMO     1.0  ! 2002-06  (A. Bozec)  F90, Free form and module 
     8   !!---------------------------------------------------------------------- 
    69#if   defined key_floats   ||   defined key_esopa 
    710   !!---------------------------------------------------------------------- 
    … …  
    1114   !!   flo_init  : initialization of float trajectories computation 
    1215   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1416   USE flo_oce         ! floats variables 
    1517   USE lib_mpp         ! distributed memory computing 
    … …  
    2224   PRIVATE   
    2325 
    24    !! * Routine accessibility 
    25    PUBLIC flo_stp    ! routine called by step.F90 
     26   PUBLIC   flo_stp    ! routine called by step.F90 
     27 
    2628   !!---------------------------------------------------------------------- 
    27    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     29   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    2830   !! $Id$  
    29    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     31   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3032   !!---------------------------------------------------------------------- 
    3133 
    … …  
    4244      !!        algorithm by default and with a 4th order Runge-Kutta scheme 
    4345      !!        if ln_flork4 =T 
    44       !!       
    45       !! History : 
    46       !!   8.5  !  02-06  (A. Bozec, G. Madec )  F90: Free form and module 
    4746      !!---------------------------------------------------------------------- 
    48       !! * arguments 
    4947      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    5048      !!---------------------------------------------------------------------- 
    51  
     49      ! 
    5250      IF( kt == nit000 ) THEN 
    5351         IF(lwp) WRITE(numout,*) 
    … …  
    5957         CALL flo_dom            ! compute/read initial position of floats 
    6058 
    61          ! Initialisation of wb for computation of floats trajectories at the first time step 
    62          wb(:,:,:) = wn(:,:,:) 
     59         wb(:,:,:) = wn(:,:,:)   ! set wb for computation of floats trajectories at the first time step 
    6360      ENDIF 
    64  
    65       IF( ln_flork4 ) THEN 
    66          CALL flo_4rk( kt )        ! Trajectories using a 4th order Runge Kutta scheme 
    67       ELSE 
    68          CALL flo_blk( kt )        ! Trajectories using Blanke' algorithme 
     61      ! 
     62      IF( ln_flork4 ) THEN   ;   CALL flo_4rk( kt )        ! Trajectories using a 4th order Runge Kutta scheme 
     63      ELSE                   ;   CALL flo_blk( kt )        ! Trajectories using Blanke' algorithme 
    6964      ENDIF 
    70  
     65      ! 
    7166      IF( lk_mpp )   CALL mppsync   ! synchronization of all the processor 
    72  
    73  
    74       ! Writing and restart       
    75        
    76       ! trajectories file  
    77       IF( kt == nit000 .OR. MOD( kt, nwritefl ) == 0 )   CALL flo_wri( kt ) 
    78       ! restart file  
    79       IF( kt == nitend .OR. MOD( kt, nstockfl ) == 0 )   CALL flo_wri( kt ) 
    80  
    81       ! Save the old vertical velocity field 
    82       wb(:,:,:) = wn(:,:,:) 
    83  
     67      ! 
     68      IF( kt == nit000 .OR. MOD( kt, nn_writefl ) == 0 )   CALL flo_wri( kt )      ! trajectories file  
     69      IF( kt == nitend .OR. MOD( kt, nn_stockfl ) == 0 )   CALL flo_wri( kt )      ! restart file  
     70      ! 
     71      wb(:,:,:) = wn(:,:,:)         ! Save the old vertical velocity field 
     72      ! 
    8473   END SUBROUTINE flo_stp 
    8574 
    … …  
    9079      !!                    
    9180      !! ** Purpose :   Read the namelist of floats 
    92       !!       
    93       !! History : 
    94       !!   8.0  !         (CLIPPER)   original Code 
    95       !!   8.5  !  02-06  (A. Bozec)  F90, Free form and module 
    9681      !!---------------------------------------------------------------------- 
    97       !! * Modules used 
    9882      USE ioipsl 
    99  
    100       !! * Local declarations 
    101       NAMELIST/namflo/ ln_rstflo, nwritefl, nstockfl, ln_argo, ln_flork4  
     83      !! 
     84      NAMELIST/namflo/ ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4  
    10285      !!--------------------------------------------------------------------- 
    103       ! Namelist namflo : floats 
    104        
    105       ! default values 
    106       ln_rstflo  = .FALSE. 
    107       nwritefl  = 150 
    108       nstockfl  = 450 
    109        
    110       ! lecture of namflo 
    111       REWIND( numnam ) 
     86      ! 
     87      REWIND( numnam )              ! Namelist namflo : floats 
    11288      READ  ( numnam, namflo ) 
    113  
    114       IF(lwp) THEN 
    115          WRITE(numout,*) ' ' 
     89      ! 
     90      IF(lwp) THEN                  ! control print 
     91         WRITE(numout,*) 
    11692         WRITE(numout,*) '         Namelist floats :' 
    11793         WRITE(numout,*) '            restart                          ln_rstflo = ', ln_rstflo 
    118          WRITE(numout,*) '            frequency of float output file   nwritefl  = ', nwritefl 
    119          WRITE(numout,*) '            frequency of float restart file  nstockfl  = ', nstockfl 
     94         WRITE(numout,*) '            frequency of float output file   nn_writefl  = ', nn_writefl 
     95         WRITE(numout,*) '            frequency of float restart file  nn_stockfl  = ', nn_stockfl 
    12096         WRITE(numout,*) '            Argo type floats                 ln_argo   = ', ln_argo 
    12197         WRITE(numout,*) '            Computation of T trajectories    ln_flork4 = ', ln_flork4 
    122          WRITE(numout,*) ' ' 
    12398      ENDIF 
    124  
     99      ! 
    125100   END SUBROUTINE flo_init 
    126101 

  • trunk/NEMO/OPA_SRC/FLO/flowri.F90

    r1581 r1601  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  flowri  *** 
    4    !!  
     4   !! lagrangian floats :   outputs 
    55   !!====================================================================== 
     6   !! History :   OPA  ! 1999-09  (Y. Drillet)  Original code 
     7   !!                  ! 2000-06  (J.-M. Molines)  Profiling floats for CLS  
     8   !!   NEMO      1.0  ! 2002-11  (G. Madec, A. Bozec)  F90: Free form and module 
     9   !!---------------------------------------------------------------------- 
     10 
    611#if   defined key_floats   ||   defined key_esopa 
    712   !!---------------------------------------------------------------------- 
    … …  
    1015   !!    flowri     : write trajectories of floats in file  
    1116   !!---------------------------------------------------------------------- 
    12    !! * Modules used 
    1317   USE flo_oce         ! ocean drifting floats 
    1418   USE oce             ! ocean dynamics and tracers 
    … …  
    1923 
    2024   IMPLICIT NONE 
    21  
    22    !! * Accessibility 
    2325   PRIVATE 
    24    PUBLIC flo_wri     ! routine called by floats.F90 
    25  
    26    !! * Module variables 
    27       INTEGER :: jfl              ! number of floats 
     26 
     27   PUBLIC   flo_wri    ! routine called by floats.F90 
     28 
     29   INTEGER ::   jfl    ! number of floats 
    2830 
    2931   !! * Substitutions 
    3032#  include "domzgr_substitute.h90" 
    3133   !!---------------------------------------------------------------------- 
    32    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     34   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    3335   !! $Id$  
    34    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     36   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3537   !!---------------------------------------------------------------------- 
    3638 
    … …  
    3840 
    3941   SUBROUTINE flo_wri( kt ) 
    40       !!--------------------------------------------------------------------- 
     42      !!------------------------------------------------------------------- 
    4143      !!                  ***  ROUTINE flo_wri  *** 
    4244      !!              
    … …  
    4446      !!      and the temperature and salinity at this position 
    4547      !!       
    46       !! ** Method  :   The frequency is nwritefl 
    47       !!       
    48       !!  History : 
    49       !!    8.0  !  99-09  (Y. Drillet)  Original code 
    50       !!         !  00-06  (J.-M. Molines)  Profiling floats for CLS  
    51       !!    8.5  !  02-10  (A. Bozec)  F90: Free form and module 
     48      !! ** Method  :   The frequency is nn_writefl 
    5249      !!---------------------------------------------------------------------- 
    53       !! * Arguments 
    54       INTEGER  :: kt                               ! time step 
    55  
    56       !! * Local declarations 
     50      INTEGER ::   kt   ! time step 
     51      !! 
    5752      CHARACTER (len=21) ::  clname 
    58       INTEGER ::   inum            ! temporary logical unit for restart file 
    59       INTEGER  ::   & 
    60          iafl,ibfl,icfl,ia1fl,ib1fl,ic1fl,jfl,irecflo,   & 
    61          iafloc,ibfloc,ia1floc,ib1floc,   & 
    62          iafln, ibfln 
     53      INTEGER ::   inum   ! temporary logical unit for restart file 
     54      INTEGER ::   iafl, ibfl, icfl, ia1fl, ib1fl, ic1fl, jfl, irecflo,   & 
     55      INTEGER ::   iafloc, ibfloc, ia1floc, ib1floc, iafln, ibfln 
    6356      INTEGER  ::    ic, jc , jpn 
    6457      INTEGER, DIMENSION ( jpnij )  :: iproc 
    … …  
    6962      !!--------------------------------------------------------------------- 
    7063       
    71       IF( kt == nit000 .OR. MOD( kt,nwritefl)== 0 ) THEN  
     64      IF( kt == nit000 .OR. MOD( kt,nn_writefl)== 0 ) THEN  
    7265 
    7366         ! header of output floats file 
    … …  
    8477 
    8578         IF( kt == nit000 ) THEN 
    86             irecflo = NINT( (nitend-nit000) / FLOAT(nwritefl) ) 
    87             IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nwritefl 
     79            irecflo = NINT( (nitend-nit000) / FLOAT(nn_writefl) ) 
     80            IF(lwp) WRITE(numflo)cexper,no,irecflo,jpnfl,nn_writefl 
    8881         ENDIF 
    8982         zdtj = rdt / 86400.      !!bug   use of 86400 instead of the phycst parameter 
    … …  
    246239      ENDIF 
    247240       
    248       IF( (MOD(kt,nstockfl) == 0) .OR. ( kt == nitend ) ) THEN  
     241      IF( (MOD(kt,nn_stockfl) == 0) .OR. ( kt == nitend ) ) THEN  
    249242         ! Writing the restart file  
    250243         IF(lwp) THEN 

  • trunk/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r1581 r1601  
    2929   !!                   namrun namelist parameters 
    3030   !!---------------------------------------------------------------------- 
    31    CHARACTER(len=16)  ::   cexper        = "exp0"      !: experiment name used for output filename 
     31   CHARACTER(len=16)  ::   cn_exp        = "exp0"      !: experiment name used for output filename 
    3232   CHARACTER(len=32)  ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input) 
    3333   CHARACTER(len=32)  ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output) 
    3434   LOGICAL            ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file 
    35    INTEGER            ::   no            = 0           !: job number 
    36    INTEGER            ::   nrstdt        = 0           !: control of the time step (0, 1 or 2) 
     35   INTEGER            ::   nn_no         = 0           !: job number 
     36   INTEGER            ::   nn_rstctl     = 0           !: control of the time step (0, 1 or 2) 
    3737   INTEGER            ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0) 
    38    INTEGER            ::   nit000        = 1           !: index of the first time step 
    39    INTEGER            ::   nitend        = 10          !: index of the last time step 
    40    INTEGER            ::   ndate0        = 961115      !: initial calendar date aammjj 
    41    INTEGER            ::   nleapy        = 0           !: Leap year calendar flag (0/1 or 30) 
    42    INTEGER            ::   ninist        = 0           !: initial state output flag (0/1) 
     38   INTEGER            ::   nn_it000      = 1           !: index of the first time step 
     39   INTEGER            ::   nn_itend      = 10          !: index of the last time step 
     40   INTEGER            ::   nn_date0      = 961115      !: initial calendar date aammjj 
     41   INTEGER            ::   nn_leapy      = 0           !: Leap year calendar flag (0/1 or 30) 
     42   INTEGER            ::   nn_istate     = 0           !: initial state output flag (0/1) 
     43   INTEGER            ::   nn_write      =   10        !: model standard output frequency 
     44   INTEGER            ::   nn_stock      =   10        !: restart file frequency 
    4345   LOGICAL            ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc 
    4446                                                       !:                  (T): 1 file per proc 
    … …  
    4648   LOGICAL            ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file 
    4749   INTEGER            ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (working only with iom_nf90 routines) 
     50 
     51   !! conversion of DOCTOR norm namelist name into model name 
     52   !! (this should disappear in a near futur) 
     53 
     54   CHARACTER(len=16)  ::   cexper                      !: experiment name used for output filename 
     55   INTEGER            ::   no                          !: job number 
     56   INTEGER            ::   nrstdt                      !: control of the time step (0, 1 or 2) 
     57   INTEGER            ::   nit000                      !: index of the first time step 
     58   INTEGER            ::   nitend                      !: index of the last time step 
     59   INTEGER            ::   ndate0                      !: initial calendar date aammjj 
     60   INTEGER            ::   nleapy                      !: Leap year calendar flag (0/1 or 30) 
     61   INTEGER            ::   ninist                      !: initial state output flag (0/1) 
     62   INTEGER            ::   nwrite                      !: model standard output frequency 
     63   INTEGER            ::   nstock                      !: restart file frequency 
     64 
    4865   !!---------------------------------------------------------------------- 
    4966   !! was in restart but moved here because of the OFF line... better solution should be found... 
    5067   !!---------------------------------------------------------------------- 
    5168   INTEGER            ::   nitrst                 !: time step at which restart file should be written 
     69 
    5270   !!---------------------------------------------------------------------- 
    5371   !!                    output monitoring 
    5472   !!---------------------------------------------------------------------- 
    5573   LOGICAL            ::   ln_ctl     = .FALSE.   !: run control for debugging 
    56    INTEGER            ::   nstock     =   10      !: restart file frequency 
    57    INTEGER            ::   nprint     =    0      !: level of print (0 no print) 
    58    INTEGER            ::   nwrite     =   10      !: restart file frequency 
    59    INTEGER            ::   nictls     =    0      !: Start i indice for the SUM control 
    60    INTEGER            ::   nictle     =    0      !: End   i indice for the SUM control 
    61    INTEGER            ::   njctls     =    0      !: Start j indice for the SUM control 
    62    INTEGER            ::   njctle     =    0      !: End   j indice for the SUM control 
    63    INTEGER            ::   isplt      =    1      !: number of processors following i 
    64    INTEGER            ::   jsplt      =    1      !: number of processors following j 
     74   INTEGER            ::   nn_print     =    0    !: level of print (0 no print) 
     75   INTEGER            ::   nn_ictls     =    0    !: Start i indice for the SUM control 
     76   INTEGER            ::   nn_ictle     =    0    !: End   i indice for the SUM control 
     77   INTEGER            ::   nn_jctls     =    0    !: Start j indice for the SUM control 
     78   INTEGER            ::   nn_jctle     =    0    !: End   j indice for the SUM control 
     79   INTEGER            ::   nn_isplt      =    1   !: number of processors following i 
     80   INTEGER            ::   nn_jsplt      =    1   !: number of processors following j 
     81   INTEGER            ::   nn_bench     =    0    !: benchmark parameter (0/1) 
     82   INTEGER            ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1) 
     83 
     84   !                                              !: OLD namelist names 
     85   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench, nbit_cmp    
     86 
    6587   INTEGER            ::   ijsplt     =    1      !: nb of local domain = nb of processors 
    66    INTEGER            ::   nbench     =    0      !: benchmark parameter (0/1) 
    67    INTEGER            ::   nbit_cmp   =    0      !: bit reproducibility  (0/1) 
     88 
    6889   !!---------------------------------------------------------------------- 
    6990   !!                        logical units 
    … …  
    84105   !!                          Run control   
    85106   !!---------------------------------------------------------------------- 
    86  
    87107   INTEGER            ::   nstop = 0                !: error flag (=number of reason for a premature stop run) 
    88108   INTEGER            ::   nwarn = 0                !: warning flag (=number of warning found during the run) 

  • trunk/NEMO/OPA_SRC/LDF/ldfdyn.F90

    r1152 r1601  
    44   !! Ocean physics:  lateral viscosity coefficient  
    55   !!===================================================================== 
     6   !! History :  OPA  ! 1997-07  (G. Madec)  multi dimensional coefficients 
     7   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
     8   !!---------------------------------------------------------------------- 
    69 
    710   !!---------------------------------------------------------------------- 
    … …  
    1114   !!   ldf_dyn_c1d   : 1D eddy viscosity coefficient initialization 
    1215   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1416   USE oce             ! ocean dynamics and tracers    
    1517   USE dom_oce         ! ocean space and time domain  
    … …  
    1719   USE phycst          ! physical constants 
    1820   USE ldfslp          ! ??? 
     21   USE ioipsl 
    1922   USE in_out_manager  ! I/O manager 
    2023   USE lib_mpp         ! distribued memory computing library 
    … …  
    2427   PRIVATE 
    2528 
    26    !! *  Routine accessibility 
    27    PUBLIC ldf_dyn_init   ! called by opa.F90 
     29   PUBLIC   ldf_dyn_init   ! called by opa.F90 
    2830 
    2931  INTERFACE ldf_zpf 
    … …  
    3436#  include "domzgr_substitute.h90" 
    3537   !!---------------------------------------------------------------------- 
    36    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     38   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    3739   !! $Id$  
    38    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     40   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3941   !!---------------------------------------------------------------------- 
    4042 
    … …  
    4850      !! 
    4951      !! ** Method  :   
    50       !!      Eddy viscosity coefficients: 
    51       !!         default option   : constant coef. ahm0 (namelist) 
    52       !!        'key_dynldf_c1d': depth dependent coef. defined in  
    53       !!                        in ldf_dyn_c1d routine 
    54       !!        'key_dynldf_c2d': latitude and longitude dependent coef. 
    55       !!                        defined in ldf_dyn_c2d routine 
    56       !!        'key_dynldf_c3d': latitude, longitude, depth dependent coef. 
    57       !!                        defined in ldf_dyn_c3d routine 
     52      !!      -  default option : ahm = constant coef. = rn_ahm_0 (namelist) 
     53      !!      - 'key_dynldf_c1d': ahm = F(depth)                     see ldf_dyn_c1d.h90 
     54      !!      - 'key_dynldf_c2d': ahm = F(latitude,longitude)        see ldf_dyn_c2d.h90 
     55      !!      - 'key_dynldf_c3d': ahm = F(latitude,longitude,depth)  see ldf_dyn_c3d.h90 
     56      !! 
    5857      !!      N.B. User defined include files.  By default, 3d and 2d coef. 
    5958      !!      are set to a constant value given in the namelist and the 1d 
    … …  
    6160      !!      profile. 
    6261      !! 
    63       !! Reference : 
    64       !!      Madec, G. and M. Imbard, 1996, A global ocean mesh to overcome 
    65       !!      the North Pole singularity, Climate Dynamics, 12, 381-388. 
    66       !! 
    67       !! History : 
    68       !!        !  07-97  (G. Madec)  from inimix.F split in 2 routines 
    69       !!        !  08-97  (G. Madec)  multi dimensional coefficients 
    70       !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
    71       !!---------------------------------------------------------------------- 
    72       !! * Modules used 
    73       USE ioipsl 
    74  
    75       !! * Local declarations 
     62      !! Reference :   Madec, G. and M. Imbard, 1996: Climate Dynamics, 12, 381-388. 
     63      !!---------------------------------------------------------------------- 
    7664      INTEGER ::   ioptio         ! ??? 
    7765      LOGICAL :: ll_print = .FALSE.    ! Logical flag for printing viscosity coef. 
    78  
    79         
    80       NAMELIST/nam_dynldf/ ln_dynldf_lap  , ln_dynldf_bilap,                & 
    81          &                 ln_dynldf_level, ln_dynldf_hor, ln_dynldf_iso,   & 
    82          &                 ahm0, ahmb0 
    83       !!---------------------------------------------------------------------- 
    84  
    85  
    86       ! Define the lateral physics parameters 
    87       ! ====================================== 
    88      
    89       ! Read Namelist nam_dynldf : Lateral physics 
    90       REWIND( numnam ) 
    91       READ  ( numnam, nam_dynldf ) 
    92  
    93       ! Parameter print 
    94       IF(lwp) THEN 
     66      !!  
     67      NAMELIST/namdyn_ldf/ ln_dynldf_lap  , ln_dynldf_bilap,                  & 
     68         &                 ln_dynldf_level, ln_dynldf_hor  , ln_dynldf_iso,   & 
     69         &                 rn_ahm_0       , rn_ahmb_0 
     70      !!---------------------------------------------------------------------- 
     71 
     72      REWIND( numnam )                  ! Read Namelist namdyn_ldf : Lateral physics 
     73      READ  ( numnam, namdyn_ldf ) 
     74 
     75      IF(lwp) THEN                      ! Parameter print 
    9576         WRITE(numout,*) 
    9677         WRITE(numout,*) 'ldf_dyn : lateral momentum physics' 
    9778         WRITE(numout,*) '~~~~~~~' 
    98          WRITE(numout,*) '          Namelist nam_dynldf : set lateral mixing parameters' 
    99          WRITE(numout,*) '             laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap 
    100          WRITE(numout,*) '             bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap 
    101          WRITE(numout,*) '             iso-level                   ln_dynldf_level = ', ln_dynldf_level 
    102          WRITE(numout,*) '             horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor 
    103          WRITE(numout,*) '             iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso 
    104          WRITE(numout,*) '             horizontal eddy viscosity            ahm0   = ', ahm0 
    105          WRITE(numout,*) '             background viscosity                 ahmb0  = ', ahmb0 
    106       ENDIF 
     79         WRITE(numout,*) '   Namelist nam_dynldf : set lateral mixing parameters' 
     80         WRITE(numout,*) '      laplacian operator          ln_dynldf_lap   = ', ln_dynldf_lap 
     81         WRITE(numout,*) '      bilaplacian operator        ln_dynldf_bilap = ', ln_dynldf_bilap 
     82         WRITE(numout,*) '      iso-level                   ln_dynldf_level = ', ln_dynldf_level 
     83         WRITE(numout,*) '      horizontal (geopotential)   ln_dynldf_hor   = ', ln_dynldf_hor 
     84         WRITE(numout,*) '      iso-neutral                 ln_dynldf_iso   = ', ln_dynldf_iso 
     85         WRITE(numout,*) '      horizontal eddy viscosity   rn_ahm_0        = ', rn_ahm_0 
     86         WRITE(numout,*) '      background viscosity        rn_ahmb_0       = ', rn_ahmb_0 
     87      ENDIF 
     88 
     89      ahm0  = rn_ahm_0                  ! OLD namelist variables defined from DOCTOR namelist variables 
     90      ahmb0 = rn_ahmb_0 
    10791 
    10892      ! ... check of lateral diffusive operator on tracers 
    … …  
    11296      ioptio = 0 
    11397#if defined key_dynldf_c3d 
    114       IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude, depth)' 
     98      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude, depth)' 
    11599      ioptio = ioptio+1 
    116100#endif 
    117101#if defined key_dynldf_c2d 
    118       IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( latitude, longitude)' 
     102      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( latitude, longitude)' 
    119103      ioptio = ioptio+1 
    120104#endif 
    121105#if defined key_dynldf_c1d 
    122       IF(lwp) WRITE(numout,*) '          momentum mixing coef. = F( depth )' 
     106      IF(lwp) WRITE(numout,*) '   momentum mixing coef. = F( depth )' 
    123107      ioptio = ioptio+1 
    124       IF( ln_sco ) CALL ctl_stop( '          key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' ) 
     108      IF( ln_sco ) CALL ctl_stop( 'key_dynldf_c1d cannot be used in s-coordinate (ln_sco)' ) 
    125109#endif 
    126110      IF( ioptio == 0 ) THEN 
    127           IF(lwp) WRITE(numout,*) '          momentum mixing coef. = constant  (default option)' 
     111          IF(lwp) WRITE(numout,*) '   momentum mixing coef. = constant  (default option)' 
    128112        ELSEIF( ioptio > 1 ) THEN 
    129            CALL ctl_stop( '          use only one of the following keys:',   & 
    130                 &         ' key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' ) 
     113           CALL ctl_stop( 'use only one of the following keys: key_dynldf_c3d, key_dynldf_c2d, key_dynldf_c1d' ) 
    131114      ENDIF 
    132115 
    133116 
    134117      IF( ln_dynldf_bilap ) THEN 
    135          IF(lwp) WRITE(numout,*) '          biharmonic momentum diffusion' 
    136          IF( ahm0 > 0 .AND. .NOT. lk_esopa )   & 
    137               &   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' ) 
     118         IF(lwp) WRITE(numout,*) '   biharmonic momentum diffusion' 
     119         IF( ahm0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be negative' ) 
    138120      ELSE 
    139          IF(lwp) WRITE(numout,*) '          harmonic momentum diff. (default)' 
    140          IF( ahm0 < 0 .AND. .NOT. lk_esopa ) & 
    141               &   CALL ctl_stop( '          The horizontal viscosity coef. ahm0 must be positive' ) 
     121         IF(lwp) WRITE(numout,*) '   harmonic momentum diff. (default)' 
     122         IF( ahm0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal viscosity coef. ahm0 must be positive' ) 
    142123      ENDIF 
    143124 
    … …  
    145126      ! Lateral eddy viscosity 
    146127      ! ====================== 
    147  
    148128#if defined key_dynldf_c3d 
    149129      CALL ldf_dyn_c3d( ll_print )   ! ahm = 3D coef. = F( longitude, latitude, depth ) 
    … …  
    159139      IF(lwp) WRITE(numout,*) '        ahm1 = ahm2 = ahm0 =  ',ahm0 
    160140#endif 
    161  
     141      ! 
    162142   END SUBROUTINE ldf_dyn_init 
    163143 
    … …  
    178158      !! 
    179159      !! ** Method  :   1D eddy viscosity coefficients ( depth ) 
    180       !! 
    181       !!---------------------------------------------------------------------- 
    182       !! * Arguments 
    183       LOGICAL , INTENT (in   ) :: ld_print   ! If true, output arrays on numout 
    184       REAL(wp), INTENT (in   ) ::   & 
    185           pdam,     &  ! depth of the inflection point 
    186           pwam,     &  ! width of inflection 
    187           pbot         ! battom value (0<pbot<= 1) 
    188       REAL(wp), INTENT (in   ), DIMENSION(jpk) ::   & 
    189           pdep         ! depth of the gridpoint (T, U, V, F) 
    190       REAL(wp), INTENT (inout), DIMENSION(jpk) ::   & 
    191           pah          ! adimensional vertical profile 
    192  
    193       !! * Local variables 
     160      !!---------------------------------------------------------------------- 
     161      LOGICAL , INTENT(in   )                 ::   ld_print   ! If true, output arrays on numout 
     162      REAL(wp), INTENT(in   )                 ::   pdam       ! depth of the inflection point 
     163      REAL(wp), INTENT(in   )                 ::   pwam       ! width of inflection 
     164      REAL(wp), INTENT(in   )                 ::   pbot       ! bottom value (0<pbot<= 1) 
     165      REAL(wp), INTENT(in   ), DIMENSION(jpk) ::   pdep       ! depth of the gridpoint (T, U, V, F) 
     166      REAL(wp), INTENT(inout), DIMENSION(jpk) ::   pah        ! adimensional vertical profile 
     167      !! 
    194168      INTEGER  ::   jk           ! dummy loop indices 
    195169      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars 
    … …  
    205179      END DO 
    206180 
    207       ! Control print 
    208       IF(lwp .AND. ld_print ) THEN 
     181      IF(lwp .AND. ld_print ) THEN      ! Control print 
    209182         WRITE(numout,*) 
    210183         WRITE(numout,*) '         ahm profile : ' 
    … …  
    215188         END DO 
    216189      ENDIF 
    217  
     190      ! 
    218191   END SUBROUTINE ldf_zpf_1d 
    219192 
    … …  
    226199      !! 
    227200      !! ** Method  :   1D eddy viscosity coefficients ( depth ) 
    228       !! 
    229       !!---------------------------------------------------------------------- 
    230       !! * Arguments 
    231       LOGICAL , INTENT (in   ) :: ld_print   ! If true, output arrays on numout 
    232       REAL(wp), INTENT (in   ) ::   & 
    233           pdam,     &  ! depth of the inflection point 
    234           pwam,     &  ! width of inflection 
    235           pbot         ! battom value (0<pbot<= 1) 
    236       REAL(wp), INTENT (in   ), DIMENSION(jpk) ::   & 
    237           pdep         ! depth of the gridpoint (T, U, V, F) 
    238       REAL(wp), INTENT (inout), DIMENSION(jpi,jpj,jpk) ::   & 
    239           pah          ! adimensional vertical profile 
    240  
    241       !! * Local variables 
     201      !!---------------------------------------------------------------------- 
     202      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout 
     203      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point 
     204      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
     205      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1) 
     206      REAL(wp), INTENT(in   ), DIMENSION        (jpk) ::   pdep       ! depth of the gridpoint (T, U, V, F) 
     207      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pah        ! adimensional vertical profile 
     208      !! 
    242209      INTEGER  ::   jk           ! dummy loop indices 
    243210      REAL(wp) ::   zm00, zm01, zmhb, zmhs, zcf  ! temporary scalars 
    … …  
    254221      END DO 
    255222 
    256       ! Control print 
    257       IF(lwp .AND. ld_print ) THEN 
     223      IF(lwp .AND. ld_print ) THEN      ! Control print 
    258224         WRITE(numout,*) 
    259225         WRITE(numout,*) '         ahm profile : ' 
    … …  
    264230         END DO 
    265231      ENDIF 
    266  
     232      ! 
    267233   END SUBROUTINE ldf_zpf_1d_3d 
    268234 
    … …  
    275241      !! 
    276242      !! ** Method  :   3D for partial step or s-coordinate 
    277       !! 
    278       !!---------------------------------------------------------------------- 
    279       !! * Arguments 
    280       LOGICAL , INTENT (in   ) :: ld_print   ! If true, output arrays on numout 
    281       REAL(wp), INTENT (in   ) ::   & 
    282           pdam,     &  ! depth of the inflection point 
    283           pwam,     &  ! width of inflection 
    284           pbot         ! reduction factor (surface value / bottom value) 
    285       REAL(wp), INTENT (in   ), DIMENSION(jpi,jpj,jpk) ::   & 
    286           pdep         ! dep of the gridpoint (T, U, V, F) 
    287       REAL(wp), INTENT (inout), DIMENSION(jpi,jpj,jpk) ::   & 
    288           pah          ! adimensional vertical profile 
    289  
    290       !! * Local variables 
     243      !!---------------------------------------------------------------------- 
     244      LOGICAL , INTENT(in   )                         ::   ld_print   ! If true, output arrays on numout 
     245      REAL(wp), INTENT(in   )                         ::   pdam       ! depth of the inflection point 
     246      REAL(wp), INTENT(in   )                         ::   pwam       ! width of inflection 
     247      REAL(wp), INTENT(in   )                         ::   pbot       ! bottom value (0<pbot<= 1) 
     248      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj,jpk) ::   pdep       ! dep of the gridpoint (T, U, V, F) 
     249      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   pah        ! adimensional vertical profile 
     250      !! 
    291251      INTEGER  ::   jk           ! dummy loop indices 
    292252      REAL(wp) ::   zm00, zm01, zmhb, zmhs       ! temporary scalars 
    … …  
    302262      END DO 
    303263 
    304       ! Control print 
    305       IF(lwp .AND. ld_print ) THEN 
     264      IF(lwp .AND. ld_print ) THEN      ! Control print 
    306265         WRITE(numout,*) 
    307266         WRITE(numout,*) '         ahm profile : ' 
    … …  
    312271         END DO 
    313272      ENDIF 
    314  
     273      ! 
    315274   END SUBROUTINE ldf_zpf_3d 
     275 
    316276   !!====================================================================== 
    317277END MODULE ldfdyn 

  • trunk/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90

    r1152 r1601  
    44   !! Ocean physics:  lateral momentum mixing coefficient defined in memory  
    55   !!====================================================================== 
    6    !! 
    7    !! ** Purpose : 
    8    !!       - Define in memory lateral momentum mixing coefficients 
    9    !! 
    10    !! History : 
    11    !!   8.5  !  02-11  (G. Madec)  F90: Free form and module 
     6   !! History :  1.0  ! 2002-11  (G. Madec)  F90: Free form and module 
    127   !!---------------------------------------------------------------------- 
    13    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    14    !! $Id$  
    15    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    16    !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    188   USE par_oce      ! ocean parameters 
    199 
    … …  
    2111   PUBLIC 
    2212 
    23    !!---------------------------------------------------------------------- 
    24    !! Lateral eddy viscosity coefficients (dynamics) 
    25    !!---------------------------------------------------------------------- 
     13   !                                                  !!* Namelist namdyn_ldf : lateral mixing * 
     14   LOGICAL , PUBLIC ::   ln_dynldf_lap   = .TRUE.      !: laplacian operator 
     15   LOGICAL , PUBLIC ::   ln_dynldf_bilap = .FALSE.     !: bilaplacian operator 
     16   LOGICAL , PUBLIC ::   ln_dynldf_level = .FALSE.     !: iso-level direction 
     17   LOGICAL , PUBLIC ::   ln_dynldf_hor   = .TRUE.      !: horizontal (geopotential) direction 
     18   LOGICAL , PUBLIC ::   ln_dynldf_iso   = .FALSE.     !: iso-neutral direction 
     19   REAL(wp), PUBLIC ::   rn_ahm_0        = 40000._wp   !: lateral eddy viscosity (m2/s) 
     20   REAL(wp), PUBLIC ::   rn_ahmb_0       =     0._wp   !: lateral background eddy viscosity (m2/s) 
    2621 
    27    LOGICAL  ::                      & !!! ** lateral mixing namelist (nam_dynldf) ** 
    28       ln_dynldf_lap   = .TRUE.  ,   &  ! laplacian operator 
    29       ln_dynldf_bilap = .FALSE. ,   &  ! bilaplacian operator 
    30       ln_dynldf_level = .FALSE. ,   &  ! iso-level direction 
    31       ln_dynldf_hor   = .TRUE.  ,   &  ! horizontal (geopotential) direction 
    32       ln_dynldf_iso   = .FALSE.        ! iso-neutral direction 
    33  
    34    REAL(wp) ::                      & !!! ** lateral mixing namelist (nam_dynldf) ** 
    35       ahm0  = 40000._wp ,   &  ! lateral eddy viscosity (m2/s) 
    36       ahmb0 =     0._wp        ! lateral background eddy viscosity (m2/s) 
     22   REAL(wp), PUBLIC ::   ahm0, ahmb0                 ! OLD namelist names 
    3723 
    3824#if defined key_dynldf_c3d 
    39    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   &  ! ** 3D coefficients ** 
     25   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ahm1, ahm2, ahm3, ahm4  ! ** 3D coefficients ** 
    4026#elif defined key_dynldf_c2d 
    41    REAL(wp), DIMENSION(jpi,jpj)     ::   &  ! ** 2D coefficients ** 
     27   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ahm1, ahm2, ahm3, ahm4  ! ** 2D coefficients ** 
    4228#elif defined key_dynldf_c1d 
    43    REAL(wp), DIMENSION(jpk)         ::   &  ! ** 2D coefficients ** 
     29   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   ahm1, ahm2, ahm3, ahm4  ! ** 2D coefficients ** 
    4430#else 
    45    REAL(wp)                         ::   &  ! ** 0D coefficients ** 
     31   REAL(wp), PUBLIC                         ::   ahm1, ahm2, ahm3, ahm4  ! ** 0D coefficients ** 
    4632#endif 
    47       ahm1, ahm2, ahm3, ahm4                ! ???? 
    4833 
    4934   !!---------------------------------------------------------------------- 
     35   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     36   !! $Id$  
     37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     38   !!====================================================================== 
    5039END MODULE ldfdyn_oce 

  • trunk/NEMO/OPA_SRC/LDF/ldftra.F90

    r1152 r1601  
    44   !! Ocean physics:  lateral diffusivity coefficient  
    55   !!===================================================================== 
    6    !! History : 
    7    !!        !  07-97  (G. Madec)  from inimix.F split in 2 routines 
    8    !!        !  08-97  (G. Madec)  multi dimensional coefficients 
    9    !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
    10    !!   9.0  !  05-11  (G. Madec)   
     6   !! History :        ! 1997-07  (G. Madec)  from inimix.F split in 2 routines 
     7   !!   NEMO      1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
     8   !!             2.0  ! 2005-11  (G. Madec)   
     9   !!---------------------------------------------------------------------- 
     10 
    1111   !!---------------------------------------------------------------------- 
    1212   !!   ldf_tra_init : initialization, namelist read, and parameters control 
    … …  
    1515   !!   ldf_tra_c1d   : 1D eddy viscosity coefficient initialization 
    1616   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1817   USE oce             ! ocean dynamics and tracers 
    1918   USE dom_oce         ! ocean space and time domain 
    … …  
    2221   USE ldfslp          ! ??? 
    2322   USE in_out_manager  ! I/O manager 
     23   USE ioipsl 
    2424   USE lib_mpp         ! distribued memory computing library 
    2525   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    2828   PRIVATE 
    2929 
    30    !! *  Routine accessibility 
    31    PUBLIC ldf_tra_init   ! called by opa.F90 
     30   PUBLIC   ldf_tra_init   ! called by opa.F90 
    3231 
    3332   !! * Substitutions 
    3433#  include "domzgr_substitute.h90" 
    3534#  include "vectopt_loop_substitute.h90" 
    36    !!--------------------------------------------------------------------------------- 
    37    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     35   !!---------------------------------------------------------------------- 
     36   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    3837   !! $Id$ 
    39    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    40    !!--------------------------------------------------------------------------------- 
     38   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     39   !!---------------------------------------------------------------------- 
    4140 
    4241CONTAINS 
    … …  
    6261      !!      coefficients are initialized to a hyperbolic tangent vertical 
    6362      !!      profile. 
    64       !! 
    6563      !!---------------------------------------------------------------------- 
    66       USE ioipsl 
    67  
    68       INTEGER ::   ioptio               ! ??? 
     64      INTEGER ::   ioptio               ! temporary integer 
    6965      LOGICAL ::   ll_print = .FALSE.   ! =T print eddy coef. in numout 
    70        
    71       NAMELIST/nam_traldf/ ln_traldf_lap  , ln_traldf_bilap,                & 
    72          &                 ln_traldf_level, ln_traldf_hor, ln_traldf_iso,   & 
    73          &                 aht0, ahtb0, aeiv0 
     66      !!  
     67      NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  & 
     68         &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   & 
     69         &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0 
    7470      !!---------------------------------------------------------------------- 
    7571 
    … …  
    7773      ! ============================================= 
    7874     
    79       ! Read Namelist nam_traldf : Lateral physics on tracers 
    80       REWIND( numnam ) 
    81       READ  ( numnam, nam_traldf ) 
     75      REWIND( numnam )                  ! Read Namelist namtra_ldf : Lateral physics on tracers 
     76      READ  ( numnam, namtra_ldf ) 
    8277 
    83       IF(lwp) THEN 
     78      IF(lwp) THEN                      ! control print 
    8479         WRITE(numout,*) 
    8580         WRITE(numout,*) 'ldf_tra_init : lateral tracer physics' 
    8681         WRITE(numout,*) '~~~~~~~~~~~~ ' 
    87          WRITE(numout,*) '          Namelist nam_traldf : lateral mixing coefficients' 
    88          WRITE(numout,*) '             laplacian operator          ln_traldf_lap   = ', ln_traldf_lap 
    89          WRITE(numout,*) '             bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap 
    90          WRITE(numout,*) '             lateral eddy diffusivity             aht0   = ', aht0 
    91          WRITE(numout,*) '             background hor. diffusivity          ahtb0  = ', ahtb0 
    92          WRITE(numout,*) '             eddy induced velocity coef.          aeiv0  = ', aeiv0 
     82         WRITE(numout,*) '   Namelist namtra_ldf : lateral mixing coefficients' 
     83         WRITE(numout,*) '      laplacian operator            ln_traldf_lap   = ', ln_traldf_lap 
     84         WRITE(numout,*) '      bilaplacian operator          ln_traldf_bilap = ', ln_traldf_bilap 
     85         WRITE(numout,*) '      lateral eddy diffusivity      rn_aht_0        = ', rn_aht_0 
     86         WRITE(numout,*) '      background hor. diffusivity   rn_ahtb_0       = ', rn_ahtb_0 
     87         WRITE(numout,*) '      eddy induced velocity coef.   rn_aeiv_0       = ', rn_aeiv_0 
    9388         WRITE(numout,*) 
    9489      ENDIF 
    9590 
    96       ! Parameter control 
     91      !                                ! convert DOCTOR namelist names into OLD names 
     92      aht0  = rn_aht_0 
     93      ahtb0 = rn_ahtb_0 
     94      aeiv0 = rn_aeiv_0 
     95 
     96      !                                ! Parameter control 
    9797 
    9898      ! ... Check consistency for type and direction : 
    … …  
    112112      IF(lwp) WRITE(numout,*) '          tracer mixing coef. = F( depth )' 
    113113      ioptio = ioptio + 1 
    114       IF( .NOT. ln_zco ) & 
    115            &   CALL ctl_stop( '          key_traldf_c1d can only be used in z-coordinate - full step' ) 
     114      IF( .NOT. ln_zco )   CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' ) 
    116115#endif 
    117116      IF( ioptio == 0 ) THEN 
    … …  
    124123      IF( ln_traldf_bilap ) THEN 
    125124         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
    126          IF( aht0 > 0 .AND. .NOT. lk_esopa )   & 
    127               &   CALL ctl_stop( '          The horizontal diffusivity coef. aht0 must be negative' ) 
     125         IF( aht0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' ) 
    128126      ELSE 
    129127         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
    130          IF( aht0 < 0 .AND. .NOT. lk_esopa )   & 
    131               &   CALL ctl_stop('          The horizontal diffusivity coef. aht0 must be positive' ) 
     128         IF( aht0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' ) 
    132129      ENDIF 
    133130 
    … …  
    135132      !  Lateral eddy diffusivity and eddy induced velocity coefficients 
    136133      ! ================================================================ 
    137  
    138134#if defined key_traldf_c3d 
    139135      CALL ldf_tra_c3d( ll_print )      ! aht = 3D coef. = F( longitude, latitude, depth ) 
    … …  
    145141                                        ! Constant coefficients 
    146142      IF(lwp)WRITE(numout,*) 
    147       IF(lwp)WRITE(numout,*) '          constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0 
     143      IF(lwp)WRITE(numout,*) '      constant eddy diffusivity coef.   ahtu = ahtv = ahtw = aht0 = ', aht0 
    148144      IF( lk_traldf_eiv ) THEN 
    149145         IF(lwp)WRITE(numout,*) 
    150          IF(lwp)WRITE(numout,*) '          constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0 
     146         IF(lwp)WRITE(numout,*) '      constant eddy induced velocity coef.   aeiu = aeiv = aeiw = aeiv0 = ', aeiv0 
    151147      ENDIF 
    152148#endif 
    153  
     149      ! 
    154150   END SUBROUTINE ldf_tra_init 
    155151 

  • trunk/NEMO/OPA_SRC/LDF/ldftra_oce.F90

    r1152 r1601  
    44   !! Ocean physics :  lateral tracer mixing coefficient defined in memory  
    55   !!===================================================================== 
    6    !! 
    7    !! ** Purpose : - Define in memory lateral tracer mixing coefficients 
    8    !! 
    9    !! History : 
    10    !!   9.0  !  02-11  (G. Madec)  Original code (from common.h) 
     6   !! History :  9.0  !  02-11  (G. Madec)  Original code 
    117   !!---------------------------------------------------------------------- 
    12    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    13    !! $Id$  
    14    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    15    !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    178   USE par_oce         ! ocean parameters 
    189 
    … …  
    2314   !! Lateral eddy diffusivity coefficients (tracers) 
    2415   !!---------------------------------------------------------------------- 
     16   !                                                !!* Namelist namtra_ldf : lateral mixing * 
     17   LOGICAL , PUBLIC ::   ln_traldf_lap   = .TRUE.    !: laplacian operator 
     18   LOGICAL , PUBLIC ::   ln_traldf_bilap = .FALSE.   !: bilaplacian operator 
     19   LOGICAL , PUBLIC ::   ln_traldf_level = .FALSE.   !: iso-level direction 
     20   LOGICAL , PUBLIC ::   ln_traldf_hor   = .FALSE.   !: horizontal (geopotential) direction 
     21   LOGICAL , PUBLIC ::   ln_traldf_iso   = .TRUE.    !: iso-neutral direction 
     22   REAL(wp), PUBLIC ::   rn_aht_0        = 2000._wp  !: lateral eddy diffusivity (m2/s) 
     23   REAL(wp), PUBLIC ::   rn_ahtb_0       =    0._wp  !: lateral background eddy diffusivity (m2/s) 
     24   REAL(wp), PUBLIC ::   rn_aeiv_0       = 2000._wp  !: eddy induced velocity coefficient (m2/s) 
    2525 
    26    LOGICAL , PUBLIC ::              & !!: ** lateral mixing namelist (nam_traldf) ** 
    27       ln_traldf_lap   = .TRUE.  ,   &  !: laplacian operator 
    28       ln_traldf_bilap = .FALSE. ,   &  !: bilaplacian operator 
    29       ln_traldf_level = .FALSE. ,   &  !: iso-level direction 
    30       ln_traldf_hor   = .FALSE. ,   &  !: horizontal (geopotential) direction 
    31       ln_traldf_iso   = .TRUE.         !: iso-neutral direction 
    32  
    33    REAL(wp), PUBLIC ::              & !!: ** lateral mixing namelist (namldf) ** 
    34       aht0  = 2000._wp     ,        &  !: lateral eddy diffusivity (m2/s) 
    35       ahtb0 =    0._wp     ,        &  !: lateral background eddy diffusivity (m2/s) 
    36       aeiv0 = 2000._wp                 !: eddy induced velocity coefficient (m2/s) 
     26   REAL(wp), PUBLIC ::   aht0, ahtb0, aeiv0         !!: OLD namelist names 
    3727 
    3828#if defined key_traldf_c3d 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients ** 
     29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ahtt, ahtu, ahtv, ahtw   !: ** 3D coefficients ** at T-, U-, V-, W-points 
    4030#elif defined key_traldf_c2d 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  !: ** 2D coefficients ** 
     31   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ahtt, ahtu, ahtv, ahtw   !: ** 2D coefficients ** at T-, U-, V-, W-points 
    4232#elif defined key_traldf_c1d 
    43    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  !: ** 1D coefficients ** 
     33   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   ahtt, ahtu, ahtv, ahtw   !: ** 1D coefficients ** at T-, U-, V-, W-points 
    4434#else 
    45    REAL(wp), PUBLIC                         ::   &  !: ** 0D coefficients ** 
     35   REAL(wp), PUBLIC                         ::   ahtt, ahtu, ahtv, ahtw   !: ** 0D coefficients ** at T-, U-, V-, W-points 
    4636#endif 
    47       ahtt, ahtu, ahtv, ahtw                !: T-, U-, V-, W-points coefficients 
    4837 
    4938 
    … …  
    5544       
    5645# if defined key_traldf_c3d 
    57    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: ** 3D coefficients ** 
     46   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   aeiu, aeiv, aeiw  !: ** 3D coefficients ** at U-, V-, W-points  [m2/s] 
    5847# elif defined key_traldf_c2d 
    59    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   &  !: ** 2D coefficients ** 
     48   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   aeiu, aeiv, aeiw  !: ** 2D coefficients ** at U-, V-, W-points  [m2/s] 
    6049# elif defined key_traldf_c1d 
    61    REAL(wp), PUBLIC, DIMENSION(jpk)         ::   &  !: ** 1D coefficients ** 
     50   REAL(wp), PUBLIC, DIMENSION(jpk)         ::   aeiu, aeiv, aeiw  !: ** 1D coefficients ** at U-, V-, W-points  [m2/s] 
    6251# else 
    63    REAL(wp), PUBLIC                         ::   &  !: ** 0D coefficients ** 
     52   REAL(wp), PUBLIC                         ::   aeiu, aeiv, aeiw  !: ** 0D coefficients ** at U-, V-, W-points  [m2/s] 
    6453# endif 
    65       aeiu, aeiv, aeiw                              !: U-, V-, W-points  induced velocity coef. (m2/s) 
    66  
    6754# if defined key_diaeiv 
    68    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::    &  !: 
    69       u_eiv, v_eiv, w_eiv     !: The three component of the eddy induced velocity (m/s) 
     55   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   u_eiv, v_eiv, w_eiv   !: eddy induced velocity [m/s] 
    7056# endif 
    7157 
    … …  
    7561   !!---------------------------------------------------------------------- 
    7662   LOGICAL , PUBLIC, PARAMETER ::   lk_traldf_eiv   = .FALSE.   !: eddy induced velocity flag 
    77    REAL(wp), PUBLIC ::   aeiu, aeiv, aeiw 
     63   REAL(wp), PUBLIC            ::   aeiu, aeiv, aeiw            !: eddy induced coef. (not used) 
    7864#endif 
    7965 
    8066   !!---------------------------------------------------------------------- 
     67   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     68   !! $Id$  
     69   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     70   !!===================================================================== 
    8171END MODULE ldftra_oce 

  • trunk/NEMO/OPA_SRC/OBC/obc_oce.F90

    r1528 r1601  
    44   !! Open Boundary Cond. :   define related variables 
    55   !!============================================================================== 
    6    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    7    !! $Id$  
    8    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    9    !!---------------------------------------------------------------------- 
    106   !!---------------------------------------------------------------------- 
    117   !!   'key_obc' :                                 Open Boundary Condition 
    … …  
    2925   !! open boundary variables 
    3026   !!---------------------------------------------------------------------- 
    31    !! 
     27   ! 
     28   !                                  !!* Namelist namobc: open boundary condition * 
     29   INTEGER           ::   nn_nbobc    = 2        !: number of open boundaries ( 1=< nbobc =< 4 )  
     30   INTEGER           ::   nn_obcdta   = 0        !:  = 0 use the initial state as obc data 
     31   !                                             !   = 1 read obc data in obcxxx.dta files 
     32   CHARACTER(len=20) ::   cn_obcdta   = 'annual' !: set to annual  if obc datafile hold 1 year of data 
     33   !                                             !  set to monthly if obc datafile hold 1 month of data 
     34   LOGICAL           ::   ln_obc_clim = .true.   !:  obc data files are climatological 
     35   LOGICAL           ::   ln_obc_fla  = .false.  !:  Flather open boundary condition not used 
     36   LOGICAL           ::   ln_vol_cst  = .true.   !:  Conservation of the whole volume 
     37   REAL(wp)          ::   rn_dpein    =  1.      !: damping time scale for inflow at East open boundary 
     38   REAL(wp)          ::   rn_dpwin    =  1.      !:    "                      "   at West open boundary 
     39   REAL(wp)          ::   rn_dpsin    =  1.      !:    "                      "   at South open boundary 
     40   REAL(wp)          ::   rn_dpnin    =  1.      !:    "                      "   at North open boundary 
     41   REAL(wp)          ::   rn_dpeob    = 15.      !: damping time scale for the climatology at East open boundary 
     42   REAL(wp)          ::   rn_dpwob    = 15.      !:    "                           "       at West open boundary 
     43   REAL(wp)          ::   rn_dpsob    = 15.      !:    "                           "       at South open boundary 
     44   REAL(wp)          ::   rn_dpnob    = 15.      !:    "                           "       at North open boundary 
     45   REAL(wp)          ::   rn_volemp   =  1.      !: = 0 the total volume will have the variability of the  
     46   !                                             !      surface Flux E-P else (volemp = 1) the volume will be constant 
     47   !                                             !  = 1 the volume will be constant during all the integration. 
     48 
     49   !                                  !!! OLD non-DOCTOR name of namelist variables 
     50   INTEGER  ::   nbobc                 !: number of open boundaries ( 1=< nbobc =< 4 )  
     51   INTEGER  ::   nobc_dta              !:  = 0 use the initial state as obc data 
     52   REAL(wp) ::   rdpein                !: damping time scale for inflow at East open boundary 
     53   REAL(wp) ::   rdpwin                !:    "                      "   at West open boundary 
     54   REAL(wp) ::   rdpsin                !:    "                      "   at South open boundary 
     55   REAL(wp) ::   rdpnin                !:    "                      "   at North open boundary 
     56   REAL(wp) ::   rdpeob                !: damping time scale for the climatology at East open boundary 
     57   REAL(wp) ::   rdpwob                !:    "                           "       at West open boundary 
     58   REAL(wp) ::   rdpsob                !:    "                           "       at South open boundary 
     59   REAL(wp) ::   rdpnob                !:    "                           "       at North open boundary 
     60   REAL(wp) ::   volemp                !: = 0 the total volume will have the variability of the  
     61   CHARACTER(len=20) :: cffile 
     62 
     63 
    3264   !!General variables for open boundaries: 
    3365   !!-------------------------------------- 
    34    INTEGER ::              & !: * namelist ??? * 
    35       nbobc    = 2  ,      & !: number of open boundaries ( 1=< nbobc =< 4 )  
    36       nobc_dta = 0           !:  = 0 use the initial state as obc data 
    37       !                      !   = 1 read obc data in obcxxx.dta files 
    38  
    39    LOGICAL ::  ln_obc_clim = .true.  !:  obc data files are climatological 
    40    LOGICAL ::  ln_obc_fla  = .false. !:  Flather open boundary condition not used 
    41    LOGICAL ::  ln_vol_cst  = .true.  !:  Conservation of the whole volume 
    42  
    43    REAL(wp) ::             & !!: open boundary namelist (namobc) 
    44       rdpein =  1.  ,      &  !: damping time scale for inflow at East open boundary 
    45       rdpwin =  1.  ,      &  !:    "                      "   at West open boundary 
    46       rdpsin =  1.  ,      &  !:    "                      "   at South open boundary 
    47       rdpnin =  1.  ,      &  !:    "                      "   at North open boundary 
    48       rdpeob = 15.  ,      &  !: damping time scale for the climatology at East open boundary 
    49       rdpwob = 15.  ,      &  !:    "                           "       at West open boundary 
    50       rdpsob = 15.  ,      &  !:    "                           "       at South open boundary 
    51       rdpnob = 15.  ,      &  !:    "                           "       at North open boundary 
    52       volemp =  1.            !: = 0 the total volume will have the variability of the  
    53                               !      surface Flux E-P else (volemp = 1) the volume will be constant 
    54                               !  = 1 the volume will be constant during all the integration. 
    55  
    5666   LOGICAL ::              &  !: 
    5767      lfbceast, lfbcwest,  &  !: logical flag for a fixed East and West open boundaries        
    … …  
    6070      !                       !  scale are set to 0 in the namelist, for both inflow and outflow). 
    6171 
    62    REAL(wp), PUBLIC ::    &  !: 
    63       obcsurftot       !: Total lateral surface of open boundaries 
     72   REAL(wp), PUBLIC ::   obcsurftot       !: Total lateral surface of open boundaries 
    6473    
    6574   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: &  !: 
    … …  
    7988   INTEGER ::   nje1m2, nje0m1    !: do loop index in mpp case for jpjefm1-1,jpjed 
    8089 
    81    REAL(wp), DIMENSION(jpj) ::    &  !: 
    82       bsfeob              !: now barotropic stream fuction computed at the OBC. The corres- 
    83       !                   ! ponding bsfn will be computed by the forward time step in dynspg. 
    84  
    85    REAL(wp), DIMENSION(jpj,3,3) ::   &  !: 
    86       bebnd               !: east boundary barotropic streamfunction over 3 rows 
    87       !                   ! and 3 time step (now, before, and before before) 
    88  
    8990   REAL(wp), DIMENSION(jpjed:jpjef) ::   &  !: 
    90       bfoe,             & !: now climatology of the east boundary barotropic stream function  
    9191      sshfoe,           & !: now climatology of the east boundary sea surface height 
    9292      ubtfoe,vbtfoe       !: now climatology of the east boundary barotropic transport 
    … …  
    9898      !                   ! in the obcdyn.F90 routine 
    9999 
    100    REAL(wp), DIMENSION(jpjed:jpjef,jpj) ::   &  !: 
    101       sshfoe_b            !: east boundary ssh correction averaged over the barotropic loop 
    102                           !: (if Flather's algoritm applied at open boundary) 
     100   REAL(wp), DIMENSION(jpjed:jpjef,jpj) ::   sshfoe_b      !: east boundary ssh correction averaged over the barotropic loop 
     101      !                                                    !  (if Flather's algoritm applied at open boundary) 
    103102 
    104103   !!------------------------------- 
    105104   !! Arrays for radiative East OBC:  
    106105   !!------------------------------- 
    107    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   &  !: 
    108       uebnd, vebnd                  !: baroclinic u & v component of the velocity over 3 rows  
    109                                     ! and 3 time step (now, before, and before before) 
    110  
    111    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   &  !: 
    112       tebnd, sebnd                  !: East boundary temperature and salinity over 2 rows  
    113                                     ! and 2 time step (now and before) 
    114  
    115    REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
    116       u_cxebnd, v_cxebnd            !: Zonal component of the phase speed ratio computed with  
    117                                     ! radiation of u and v velocity (respectively) at the  
    118                                     ! east open boundary (u_cxebnd = cx rdt ) 
    119  
    120    REAL(wp), DIMENSION(jpj,jpk) ::   &  !: 
    121       uemsk, vemsk, temsk           !: 2D mask for the East OB 
     106   REAL(wp), DIMENSION(jpj,jpk,3,3) ::   uebnd, vebnd      !: baroclinic u & v component of the velocity over 3 rows  
     107      !                                                    !  and 3 time step (now, before, and before before) 
     108   REAL(wp), DIMENSION(jpj,jpk,2,2) ::   tebnd, sebnd      !: East boundary temperature and salinity over 2 rows  
     109      !                                                    !  and 2 time step (now and before) 
     110   REAL(wp), DIMENSION(jpj,jpk) ::   u_cxebnd, v_cxebnd    !: Zonal component of the phase speed ratio computed with  
     111      !                                                    !  radiation of u and v velocity (respectively) at the  
     112      !                                                    !  east open boundary (u_cxebnd = cx rdt ) 
     113   REAL(wp), DIMENSION(jpj,jpk) ::   uemsk, vemsk, temsk   !: 2D mask for the East OB 
    122114 
    123115   ! Note that those arrays are optimized for mpp case  
    … …  
    133125   INTEGER ::   njw1m2, njw0m1     !: do loop index in mpp case for jpjwfm2,jpjwd 
    134126 
    135    REAL(wp), DIMENSION(jpj) ::   &  !: 
    136       bsfwob              !: now barotropic stream fuction computed at the OBC. The corres- 
    137       !                   !  ponding bsfn will be computed by the forward time step in dynspg. 
    138  
    139    REAL(wp), DIMENSION(jpj,3,3) ::   &  !: 
    140       bwbnd               !: West boundary barotropic streamfunction over 
    141       !                   !  3 rows and 3 time step (now, before, and before before) 
    142  
    143127   REAL(wp), DIMENSION(jpjwd:jpjwf) ::   &  !: 
    144       bfow,             & !: now climatology of the west boundary barotropic stream function 
    145128      sshfow,           & !: now climatology of the west boundary sea surface height 
    146129      ubtfow,vbtfow       !: now climatology of the west boundary barotropic transport 
    … …  
    152135      !                   !  in the obcdyn.F90 routine 
    153136 
    154    REAL(wp), DIMENSION(jpjwd:jpjwf,jpj) ::   &  !: 
    155       sshfow_b            !: west boundary ssh correction averaged over the barotropic loop 
    156                           !: (if Flather's algoritm applied at open boundary) 
     137   REAL(wp), DIMENSION(jpjwd:jpjwf,jpj) ::   sshfow_b    !: west boundary ssh correction averaged over the barotropic loop 
     138      !                                                  !  (if Flather's algoritm applied at open boundary) 
    157139 
    158140   !!------------------------------- 
    159141   !! Arrays for radiative West OBC 
    160142   !!------------------------------- 
    161    REAL(wp), DIMENSION(jpj,jpk,3,3) ::   &  !: 
    162       uwbnd, vwbnd                  !: baroclinic u & v components of the velocity over 3 rows  
    163       !                             !  and 3 time step (now, before, and before before) 
    164  
    165    REAL(wp), DIMENSION(jpj,jpk,2,2) ::   &  !: 
    166       twbnd, swbnd                  !: west boundary temperature and salinity over 2 rows and  
    167       !                             !  2 time step (now and before) 
    168  
    169    REAL(wp), DIMENSION(jpj,jpk) ::    &  !: 
    170       u_cxwbnd, v_cxwbnd            !: Zonal component of the phase speed ratio computed with  
    171       !                             !  radiation of zonal and meridional velocity (respectively)  
    172       !                             !  at the west open boundary (u_cxwbnd = cx rdt ) 
    173  
    174    REAL(wp), DIMENSION(jpj,jpk) ::    &  !: 
    175       uwmsk, vwmsk, twmsk           !: 2D mask for the West OB 
     143   REAL(wp), DIMENSION(jpj,jpk,3,3) ::   uwbnd, vwbnd     !: baroclinic u & v components of the velocity over 3 rows  
     144      !                                                   !  and 3 time step (now, before, and before before) 
     145   REAL(wp), DIMENSION(jpj,jpk,2,2) ::   twbnd, swbnd     !: west boundary temperature and salinity over 2 rows and  
     146      !                                                   !  2 time step (now and before) 
     147   REAL(wp), DIMENSION(jpj,jpk) ::   u_cxwbnd, v_cxwbnd   !: Zonal component of the phase speed ratio computed with  
     148      !                                                   !  radiation of zonal and meridional velocity (respectively)  
     149      !                                                   !  at the west open boundary (u_cxwbnd = cx rdt ) 
     150   REAL(wp), DIMENSION(jpj,jpk) ::   uwmsk, vwmsk, twmsk  !: 2D mask for the West OB 
    176151 
    177152   ! Note that those arrays are optimized for mpp case  
    … …  
    188163   INTEGER ::   njn0m1, njn1m1     !: do loop index in mpp case for jpnob-1 
    189164 
    190    REAL(wp), DIMENSION(jpi) ::   &  !: 
    191       bsfnob              !: now barotropic stream fuction computed at the OBC. The corres- 
    192       !                   !  ponding bsfn will be computed by the forward time step in dynspg. 
    193  
    194    REAL(wp), DIMENSION(jpi,3,3) ::   &  !: 
    195       bnbnd               !: north boundary barotropic streamfunction over 
    196       !                   !  3 rows and 3 time step (now, before, and before before) 
    197  
    198165   REAL(wp), DIMENSION(jpind:jpinf) ::   &  !: 
    199       bfon,             & !: now climatology of the north boundary barotropic stream function 
    200166      sshfon,           & !: now climatology of the north boundary sea surface height 
    201167      ubtfon,vbtfon       !: now climatology of the north boundary barotropic transport 
    … …  
    207173      !                   !  in yhe obcdyn.F90 routine 
    208174 
    209    REAL(wp), DIMENSION(jpind:jpinf,jpj) ::   &  !: 
    210       sshfon_b            !: north boundary ssh correction averaged over the barotropic loop 
    211                           !: (if Flather's algoritm applied at open boundary) 
     175   REAL(wp), DIMENSION(jpind:jpinf,jpj) ::   sshfon_b      !: north boundary ssh correction averaged over the barotropic loop 
     176      !                                                    !  (if Flather's algoritm applied at open boundary) 
    212177 
    213178   !!-------------------------------- 
    214179   !! Arrays for radiative North OBC 
    215180   !!-------------------------------- 
    216    !!    
    217    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   &   !: 
    218       unbnd, vnbnd                  !: baroclinic u & v components of the velocity over 3 
    219       !                             !  rows and 3 time step (now, before, and before before) 
    220  
    221    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   &   !: 
    222       tnbnd, snbnd                  !: north boundary temperature and salinity over 
    223       !                             !  2 rows and 2 time step (now and before) 
    224  
    225    REAL(wp), DIMENSION(jpi,jpk) ::   &     !: 
    226       u_cynbnd, v_cynbnd            !: Meridional component of the phase speed ratio compu- 
    227       !                             !  ted with radiation of zonal and meridional velocity  
    228       !                             !  (respectively) at the north OB (u_cynbnd = cx rdt ) 
    229  
    230    REAL(wp), DIMENSION(jpi,jpk) ::   &  !: 
    231       unmsk, vnmsk, tnmsk           !: 2D mask for the North OB 
     181   REAL(wp), DIMENSION(jpi,jpk,3,3) ::   unbnd, vnbnd      !: baroclinic u & v components of the velocity over 3 
     182      !                                                    !  rows and 3 time step (now, before, and before before) 
     183   REAL(wp), DIMENSION(jpi,jpk,2,2) ::   tnbnd, snbnd      !: north boundary temperature and salinity over 
     184      !                                                    !  2 rows and 2 time step (now and before) 
     185   REAL(wp), DIMENSION(jpi,jpk) ::   u_cynbnd, v_cynbnd    !: Meridional component of the phase speed ratio compu- 
     186      !                                                    !  ted with radiation of zonal and meridional velocity  
     187      !                                                    !  (respectively) at the north OB (u_cynbnd = cx rdt ) 
     188   REAL(wp), DIMENSION(jpi,jpk) ::   unmsk, vnmsk, tnmsk   !: 2D mask for the North OB 
    232189 
    233190   ! Note that those arrays are optimized for mpp case  
    … …  
    243200   INTEGER ::   njs0p1, njs1p1     !: do loop index in mpp case for jpsob+1 
    244201 
    245    REAL(wp), DIMENSION(jpi) ::    &   !: 
    246       bsfsob              !: now barotropic stream fuction computed at the OBC.The corres- 
    247       !                   !  ponding bsfn will be computed by the forward time step in dynspg. 
    248    REAL(wp), DIMENSION(jpi,3,3) ::   &   !: 
    249       bsbnd               !: south boundary barotropic stream function over 
    250       !                   !  3 rows and 3 time step (now, before, and before before) 
    251  
    252202   REAL(wp), DIMENSION(jpisd:jpisf) ::    &   !: 
    253       bfos,             & !: now climatology of the south boundary barotropic stream function 
    254203      sshfos,           & !: now climatology of the south boundary sea surface height 
    255204      ubtfos,vbtfos       !: now climatology of the south boundary barotropic transport 
    … …  
    261210      !                   !  in the obcdyn.F90 routine 
    262211 
    263    REAL(wp), DIMENSION(jpisd:jpisf,jpj) ::   &  !: 
    264       sshfos_b            !: south boundary ssh correction averaged over the barotropic loop 
    265                           !: (if Flather's algoritm applied at open boundary) 
    266  
    267    !!-------------------------------- 
    268    !! Arrays for radiative South OBC 
    269    !!-------------------------------- 
    270    !!                        computed by the forward time step in dynspg. 
    271    REAL(wp), DIMENSION(jpi,jpk,3,3) ::   &   !: 
    272       usbnd, vsbnd                  !: baroclinic u & v components of the velocity over 3  
    273       !                             !  rows and 3 time step (now, before, and before before) 
    274  
    275    REAL(wp), DIMENSION(jpi,jpk,2,2) ::   &  !: 
    276       tsbnd, ssbnd                  !: south boundary temperature and salinity over 
    277       !                             !  2 rows and 2 time step (now and before) 
    278  
    279    REAL(wp), DIMENSION(jpi,jpk) ::   &  !: 
    280       u_cysbnd, v_cysbnd            !: Meridional component of the phase speed ratio compu- 
    281       !                             !  ted with radiation of zonal and meridional velocity  
    282       !                             !  (repsectively) at the south OB (u_cynbnd = cx rdt ) 
    283  
    284    REAL(wp), DIMENSION(jpi,jpk) ::   &  !: 
    285       usmsk, vsmsk, tsmsk           !: 2D mask for the South OB 
    286  
    287    CHARACTER ( len=20 ) :: cffile 
     212   REAL(wp), DIMENSION(jpisd:jpisf,jpj) ::   sshfos_b     !: south boundary ssh correction averaged over the barotropic loop 
     213      !                                                   !  (if Flather's algoritm applied at open boundary) 
     214 
     215   !!-------------------------------- 
     216   !! Arrays for radiative South OBC   (computed by the forward time step in dynspg) 
     217   !!-------------------------------- 
     218   REAL(wp), DIMENSION(jpi,jpk,3,3) ::   usbnd, vsbnd     !: baroclinic u & v components of the velocity over 3  
     219      !                                                   !  rows and 3 time step (now, before, and before before) 
     220   REAL(wp), DIMENSION(jpi,jpk,2,2) ::   tsbnd, ssbnd     !: south boundary temperature and salinity over 
     221      !                                                   !  2 rows and 2 time step (now and before) 
     222   REAL(wp), DIMENSION(jpi,jpk) ::   u_cysbnd, v_cysbnd   !: Meridional component of the phase speed ratio 
     223      !                                                   !  computed with radiation of zonal and meridional velocity  
     224      !                                                   !  (repsectively) at the south OB (u_cynbnd = cx rdt ) 
     225   REAL(wp), DIMENSION(jpi,jpk) ::   usmsk, vsmsk, tsmsk  !: 2D mask for the South OB 
    288226 
    289227#else 
    … …  
    293231#endif 
    294232 
     233   !!---------------------------------------------------------------------- 
     234   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     235   !! $Id$  
     236   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    295237   !!====================================================================== 
    296238END MODULE obc_oce 

  • trunk/NEMO/OPA_SRC/OBC/obcini.F90

    r1528 r1601  
    11 MODULE obcini 
    2    !!================================================================================= 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  obcini  *** 
    44   !! OBC initial state :  Open boundary initial state 
    5    !!================================================================================= 
     5   !!====================================================================== 
     6   !! History :  8.0  !  97-07  (J.M. Molines, G. Madec)  Original code 
     7   !!   NEMO     1.0  !  02-11  (C. Talandier, A-M. Treguier) Free surface, F90 
     8   !!            2.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
     9   !!---------------------------------------------------------------------- 
    610#if defined key_obc 
    7    !!--------------------------------------------------------------------------------- 
    8    !!   'key_obc'                                             Open Boundary Conditions 
    9    !!--------------------------------------------------------------------------------- 
     11   !!---------------------------------------------------------------------- 
     12   !!   'key_obc'                                  Open Boundary Conditions 
     13   !!---------------------------------------------------------------------- 
    1014   !!   obc_init       : initialization for the open boundary condition 
    11    !!--------------------------------------------------------------------------------- 
    12    !! * Modules used 
     15   !!---------------------------------------------------------------------- 
    1316   USE oce             ! ocean dynamics and tracers variables 
    1417   USE dom_oce         ! ocean space and time domain variables 
    … …  
    2326   PRIVATE 
    2427 
    25    !! * Routine accessibility 
    26    PUBLIC obc_init        ! routine called by opa.F90 
     28   PUBLIC   obc_init   ! routine called by opa.F90 
    2729 
    2830   !! * Substitutions 
    2931#  include "obc_vectopt_loop_substitute.h90" 
    30    !!--------------------------------------------------------------------------------- 
    31    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     32   !!---------------------------------------------------------------------- 
     33   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2005)  
    3234   !! $Id$  
    33    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    34    !!--------------------------------------------------------------------------------- 
     35   !! software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     36   !!---------------------------------------------------------------------- 
    3537 
    3638CONTAINS 
    … …  
    4143      !!          
    4244      !! ** Purpose :   Initialization of the dynamics and tracer fields at  
    43       !!      the open boundaries. 
     45      !!              the open boundaries. 
    4446      !! 
    4547      !! ** Method  :   initialization of open boundary variables 
    … …  
    5153      !! 
    5254      !! ** Input   :   restart.obc file, restart file for open boundaries  
     55      !!---------------------------------------------------------------------- 
     56      USE obcrst,   ONLY :   obc_rst_read   ! Make obc_rst_read routine available 
    5357      !! 
    54       !! History : 
    55       !!   8.0  !  97-07  (G. Madec)  Original code 
    56       !!        !  97-11  (J.M. Molines) 
    57       !!   8.5  !  02-11  (C. Talandier, A-M. Treguier) Free surface, F90 
    58       !!   9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    59       !!---------------------------------------------------------------------- 
    60       !! * Modules used 
    61       USE obcrst,   ONLY :   obc_rst_read   ! Make obc_rst_read routine available 
    62  
    63       !! * Local declarations 
    6458      INTEGER  ::   ji, jj, istop , inumfbc 
    6559      INTEGER, DIMENSION(4) ::   icorner 
    66       REAL(wp) ::   zbsic1, zbsic2, zbsic3 
    6760      REAL(wp), DIMENSION(2) ::   ztestmask 
    68  
    69       NAMELIST/namobc/ rdpein, rdpwin, rdpnin, rdpsin,   & 
    70          &             rdpeob, rdpwob, rdpnob, rdpsob,   & 
    71          &             zbsic1, zbsic2, zbsic3,           & 
    72          &             volemp, nobc_dta, cffile,         & 
     61      !! 
     62      NAMELIST/namobc/ rn_dpein, rn_dpwin, rn_dpnin, rn_dpsin,      & 
     63         &             rn_dpeob, rn_dpwob, rn_dpnob, rn_dpsob,      & 
     64         &             rn_volemp, nn_obcdta, cn_obcdta, rn_volemp   & 
    7365         &             ln_obc_clim, ln_vol_cst, ln_obc_fla 
    7466      !!---------------------------------------------------------------------- 
    7567 
    76       IF(lwp) WRITE(numout,*) 
    77       IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries' 
    78       IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    79  
    80  
    81       ! 0. read namelist parameters 
    82       ! --------------------------- 
    83       ! default values already set except: 
    84       zbsic1 = 0.e0 
    85       zbsic2 = 0.e0 
    86       zbsic3 = 0.e0 
    87  
    88       ! Namelist namobc : open boundaries 
    89       REWIND( numnam ) 
     68      REWIND( numnam )              ! Namelist namobc : open boundaries 
    9069      READ  ( numnam, namobc ) 
    9170 
    92       ! By security we set rdpxin and rdpxob respectively 
    93       ! to 1. and 15. if the corresponding OBC is not activated 
    94       IF( .NOT.lp_obc_east  ) THEN ; rdpein = 1. ; rdpeob = 15. ; END IF 
    95       IF( .NOT.lp_obc_west  ) THEN ; rdpwin = 1. ; rdpwob = 15. ; END IF 
    96       IF( .NOT.lp_obc_north ) THEN ; rdpnin = 1. ; rdpnob = 15. ; END IF 
    97       IF( .NOT.lp_obc_south ) THEN ; rdpsin = 1. ; rdpsob = 15. ; END IF 
     71      ! convert DOCTOR namelist name into the OLD names 
     72      nbobc    = nn_nbobc 
     73      nobc_dta = nn_obcdta 
     74      cffile   = cn_obcdta 
     75      rdpein   = rn_dpein 
     76      rdpwin   = rn_dpwin 
     77      rdpsin   = rn_dpsin 
     78      rdpnin   = rn_dpnin 
     79      rdpeob   = rn_dpeob 
     80      rdpwob   = rn_dpwob 
     81      rdpsob   = rn_dpsob 
     82      rdpnob   = rn_dpnob 
     83      volemp   = rn_volemp 
     84       
     85 
     86 
     87      ! By security we set rdpxin and rdpxob respectively to 1. and 15. if the corresponding OBC is not activated 
     88      IF( .NOT.lp_obc_east  ) THEN   ;   rdpein = 1.   ;   rdpeob = 15.   ;   END IF 
     89      IF( .NOT.lp_obc_west  ) THEN   ;   rdpwin = 1.   ;   rdpwob = 15.   ;   END IF 
     90      IF( .NOT.lp_obc_north ) THEN   ;   rdpnin = 1.   ;   rdpnob = 15.   ;   END IF 
     91      IF( .NOT.lp_obc_south ) THEN   ;   rdpsin = 1.   ;   rdpsob = 15.   ;   END IF 
    9892 
    9993      ! number of open boudaries and open boundary indicators 
    … …  
    10498      IF( lp_obc_south )   nbobc = nbobc + 1 
    10599 
    106       IF(lwp) WRITE(numout,*) '         Number of open boundaries    nbobc = ',nbobc 
    107100      IF(lwp) WRITE(numout,*) 
    108       IF( nbobc /= 0 .AND. jperio /= 0 ) & 
    109            &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 
     101      IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries' 
     102      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
     103      IF(lwp) WRITE(numout,*) '   Number of open boundaries    nn_nbobc = ', nn_nbobc 
     104      IF(lwp) WRITE(numout,*) 
    110105 
    111106      ! control prints 
    112       IF(lwp) WRITE(numout,*) '         namobc' 
     107      IF(lwp) WRITE(numout,*) '   Namelist namobc' 
     108      IF(lwp) WRITE(numout,*) '      data in file (=1) or initial state used (=0)   nn_obcdta   = ', nn_obcdta 
     109      IF(lwp) WRITE(numout,*) '      climatology (true) or not                      ln_obc_clim = ', ln_obc_clim 
     110      IF(lwp) WRITE(numout,*) '      vol_cst (true) or not:                         ln_vol_cst  = ', ln_vol_cst 
    113111      IF(lwp) WRITE(numout,*) ' ' 
    114       IF(lwp) WRITE(numout,*) '         data in file (=1) or     nobc_dta = ', nobc_dta 
    115       IF(lwp) WRITE(numout,*) '         initial state used (=0)             ' 
    116       IF(lwp) WRITE(numout,*) '         climatology (true) or not:', ln_obc_clim 
    117       IF(lwp) WRITE(numout,*) '         vol_cst (true) or not:', ln_vol_cst 
    118       IF(lwp) THEN 
    119           IF ( lk_dynspg_flt ) WRITE(numout,*) '                   dynspg_flt T ==> vol_cst forced to T' 
    120       ENDIF 
    121       IF(lwp) WRITE(numout,*) ' ' 
    122       IF(lwp) WRITE(numout,*) '                                 WARNING                                                  ' 
    123       IF(lwp) WRITE(numout,*) '         Flather"s algorithm is applied with explicit free surface scheme                 ' 
    124       IF(lwp) WRITE(numout,*) '         or with free surface time-splitting scheme                                       ' 
    125       IF(lwp) WRITE(numout,*) '         Nor radiation neither relaxation is allowed with explicit free surface scheme:   ' 
    126       IF(lwp) WRITE(numout,*) '         Radiation and/or relaxation is allowed with free surface time-splitting scheme ' 
    127       IF(lwp) WRITE(numout,*) '         depending of the choice of rdpXin = rdpXob  = 0. for open boundaries             ' 
    128       IF(lwp) WRITE(numout,*) ' ' 
    129       IF(lwp) WRITE(numout,*) '         For the filtered free surface case,                                              ' 
    130       IF(lwp) WRITE(numout,*) '         radiation, relaxation or presciption of data can be applied                      ' 
     112      IF(lwp) WRITE(numout,*) '   WARNING                                                  ' 
     113      IF(lwp) WRITE(numout,*) '      Flather"s algorithm is applied with explicit free surface scheme                 ' 
     114      IF(lwp) WRITE(numout,*) '      or with free surface time-splitting scheme                                       ' 
     115      IF(lwp) WRITE(numout,*) '      Nor radiation neither relaxation is allowed with explicit free surface scheme:   ' 
     116      IF(lwp) WRITE(numout,*) '      Radiation and/or relaxation is allowed with free surface time-splitting scheme ' 
     117      IF(lwp) WRITE(numout,*) '      depending of the choice of rdpXin = rdpXob  = 0. for open boundaries             ' 
     118      IF(lwp) WRITE(numout,*) 
     119      IF(lwp) WRITE(numout,*) '      For the filtered free surface case,                                              ' 
     120      IF(lwp) WRITE(numout,*) '      radiation, relaxation or presciption of data can be applied                      ' 
     121      IF(lwp) WRITE(numout,*) 
    131122 
    132123      IF( lwp.AND.lp_obc_east ) THEN 
    133          WRITE(numout,*) '         East open boundary :' 
    134          WRITE(numout,*) '              i index                    jpieob = ', jpieob 
    135          WRITE(numout,*) '              damping time scale (days)  rdpeob = ', rdpeob 
    136          WRITE(numout,*) '              damping time scale (days)  rdpein = ', rdpein 
     124         WRITE(numout,*) '      East open boundary :' 
     125         WRITE(numout,*) '         i index                    jpieob  = ', jpieob 
     126         WRITE(numout,*) '         damping time scale (days)  rn_dpeob = ', rn_dpeob 
     127         WRITE(numout,*) '         damping time scale (days)  rn_dpein = ', rn_dpein 
    137128      ENDIF 
    138129 
    139130      IF( lwp.AND.lp_obc_west ) THEN 
    140          WRITE(numout,*) '         West open boundary :' 
    141          WRITE(numout,*) '              i index                    jpiwob = ', jpiwob 
    142          WRITE(numout,*) '              damping time scale (days)  rdpwob = ', rdpwob 
    143          WRITE(numout,*) '              damping time scale (days)  rdpwin = ', rdpwin 
     131         WRITE(numout,*) '      West open boundary :' 
     132         WRITE(numout,*) '         i index                    jpiwob  = ', jpiwob 
     133         WRITE(numout,*) '         damping time scale (days)  rn_dpwob = ', rn_dpwob 
     134         WRITE(numout,*) '         damping time scale (days)  rn_dpwin = ', rn_dpwin 
    144135      ENDIF 
    145136 
    146137      IF( lwp.AND.lp_obc_north ) THEN 
    147          WRITE(numout,*) '         North open boundary :' 
    148          WRITE(numout,*) '               j index                    jpjnob = ', jpjnob 
    149          WRITE(numout,*) '               damping time scale (days)  rdpnob = ', rdpnob 
    150          WRITE(numout,*) '               damping time scale (days)  rdpnin = ', rdpnin 
     138         WRITE(numout,*) '      North open boundary :' 
     139         WRITE(numout,*) '         j index                    jpjnob  = ', jpjnob 
     140         WRITE(numout,*) '         damping time scale (days)  rn_dpnob = ', rn_dpnob 
     141         WRITE(numout,*) '         damping time scale (days)  rn_dpnin = ', rn_dpnin 
    151142      ENDIF 
    152143 
    153144      IF( lwp.AND.lp_obc_south ) THEN 
    154          WRITE(numout,*) '         South open boundary :' 
    155          WRITE(numout,*) '               j index                    jpjsob = ', jpjsob 
    156          WRITE(numout,*) '               damping time scale (days)  rdpsob = ', rdpsob 
    157          WRITE(numout,*) '               damping time scale (days)  rdpsin = ', rdpsin 
    158          WRITE(numout,*) ' ' 
    159       ENDIF 
     145         WRITE(numout,*) '      South open boundary :' 
     146         WRITE(numout,*) '         j index                    jpjsob   = ', jpjsob 
     147         WRITE(numout,*) '         damping time scale (days)  rn_dpsob = ', rn_dpsob 
     148         WRITE(numout,*) '         damping time scale (days)  rn_dpsin = ', rn_dpsin 
     149         WRITE(numout,*) 
     150      ENDIF 
     151 
     152      IF( nbobc /= 0 .AND. jperio /= 0 )   & 
     153         &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 
    160154 
    161155      ! 1. Initialisation of constants  
    162156      ! ------------------------------ 
    163  
    164157      ! ...                          convert rdp$ob in seconds 
    165158      ! Fixed Bdy flag              inbound                outbound 
    166       lfbceast  = .FALSE. ; rdpein = rdpein * rday  ; rdpeob = rdpeob * rday 
    167       lfbcwest  = .FALSE. ; rdpwin = rdpwin * rday  ; rdpwob = rdpwob * rday 
    168       lfbcnorth = .FALSE. ; rdpnin = rdpnin * rday  ; rdpnob = rdpnob * rday 
    169       lfbcsouth = .FALSE. ; rdpsin = rdpsin * rday  ; rdpsob = rdpsob * rday 
     159      lfbceast  = .FALSE.   ;   rdpein = rdpein * rday    ;  rdpeob = rdpeob * rday 
     160      lfbcwest  = .FALSE.   ;   rdpwin = rdpwin * rday    ;  rdpwob = rdpwob * rday 
     161      lfbcnorth = .FALSE.   ;   rdpnin = rdpnin * rday    ;  rdpnob = rdpnob * rday 
     162      lfbcsouth = .FALSE.   ;   rdpsin = rdpsin * rday    ;  rdpsob = rdpsob * rday 
    170163      inumfbc = 0 
    171164      ! ... look for Fixed Boundaries (rdp = 0 ) 
    … …  
    175168      IF( lp_obc_east )  THEN 
    176169         IF( (rdpein+rdpeob) == 0 )  THEN 
    177             lfbceast = .TRUE. ; rdpein = 1e-3 ; rdpeob = 1e-3 
     170            lfbceast = .TRUE.   ;   rdpein = 1e-3   ;  rdpeob = 1e-3 
    178171            inumfbc = inumfbc+1 
    179172         ELSEIF ( (rdpein*rdpeob) == 0 )  THEN 
    180             CALL ctl_stop( 'obc_init : rdpein & rdpeob must be both zero or non zero' ) 
     173            CALL ctl_stop( 'obc_init : rn_dpein & rn_dpeob must be both zero or non zero' ) 
    181174         END IF 
    182175      END IF 
    … …  
    184177      IF( lp_obc_west )  THEN 
    185178         IF( (rdpwin + rdpwob) == 0 )  THEN 
    186             lfbcwest = .TRUE. ; rdpwin = 1e-3 ; rdpwob = 1e-3 
     179            lfbcwest = .TRUE.     ;     rdpwin = 1e-3     ;    rdpwob = 1e-3 
    187180            inumfbc = inumfbc+1 
    188181         ELSEIF ( (rdpwin*rdpwob) == 0 )  THEN 
    189             CALL ctl_stop( 'obc_init : rdpwin & rdpwob must be both zero or non zero' ) 
     182            CALL ctl_stop( 'obc_init : rn_dpwin & rn_dpwob must be both zero or non zero' ) 
    190183         END IF 
    191184      END IF 
    192185      IF( lp_obc_north )  THEN 
    193186         IF( (rdpnin + rdpnob) == 0 )  THEN 
    194             lfbcnorth = .TRUE. ; rdpnin = 1e-3 ; rdpnob = 1e-3 
     187            lfbcnorth = .TRUE.     ;     rdpnin = 1e-3     ;    rdpnob = 1e-3 
    195188            inumfbc = inumfbc+1 
    196189         ELSEIF ( (rdpnin*rdpnob) == 0 )  THEN 
    197             CALL ctl_stop( 'obc_init : rdpnin & rdpnob must be both zero or non zero' ) 
     190            CALL ctl_stop( 'obc_init : rn_dpnin & rn_dpnob must be both zero or non zero' ) 
    198191         END IF 
    199192      END IF 
    200193      IF( lp_obc_south )  THEN 
    201194         IF( (rdpsin + rdpsob) == 0 )  THEN 
    202             lfbcsouth = .TRUE. ; rdpsin = 1e-3 ; rdpsob = 1e-3 
     195            lfbcsouth = .TRUE.   ;   rdpsin = 1e-3   ;  rdpsob = 1e-3 
    203196            inumfbc = inumfbc+1 
    204197         ELSEIF ( (rdpsin*rdpsob) == 0 )  THEN 
    205             CALL ctl_stop( 'obc_init : rdpsin & rdpsob must be both zero or non zero' ) 
     198            CALL ctl_stop( 'obc_init : rn_dpsin & rn_dpsob must be both zero or non zero' ) 
    206199         END IF 
    207200      END IF 
    … …  
    315308 
    316309         ! ... initilization to zero 
    317          uemsk(:,:) = 0.e0 ; vemsk(:,:) = 0.e0 ; temsk(:,:) = 0.e0 
     310         uemsk(:,:) = 0.e0   ;   vemsk(:,:) = 0.e0   ;  temsk(:,:) = 0.e0 
    318311 
    319312         ! ... set 2D mask on East OBC,  Vopt 
    … …  
    333326 
    334327         ! ... initilization to zero 
    335          uwmsk(:,:) = 0.e0 ; vwmsk(:,:) = 0.e0 ; twmsk(:,:) = 0.e0   
     328         uwmsk(:,:) = 0.e0   ;   vwmsk(:,:) = 0.e0   ;  twmsk(:,:) = 0.e0   
    336329 
    337330         ! ... set 2D mask on West OBC,  Vopt 
    … …  
    350343 
    351344         ! ... initilization to zero 
    352          unmsk(:,:) = 0.e0 ; vnmsk(:,:) = 0.e0 ; tnmsk(:,:) = 0.e0 
     345         unmsk(:,:) = 0.e0   ;   vnmsk(:,:) = 0.e0   ;  tnmsk(:,:) = 0.e0 
    353346 
    354347         ! ... set 2D mask on North OBC,  Vopt 
    … …  
    368361 
    369362         ! ... initilization to zero 
    370          usmsk(:,:) = 0.e0 ; vsmsk(:,:) = 0.e0 ; tsmsk(:,:) = 0.e0 
     363         usmsk(:,:) = 0.e0   ;   vsmsk(:,:) = 0.e0   ;  tsmsk(:,:) = 0.e0 
    371364 
    372365         ! ... set 2D mask on South OBC,  Vopt 

  • trunk/NEMO/OPA_SRC/SBC/albedo.F90

    r1463 r1601  
    44   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice) 
    55   !!===================================================================== 
    6    !! History :  8.0  !  01-04  (LIM 1.0) 
    7    !!            8.5  !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
    8    !!            9.0  !  04-11  (C. Talandier)  add albedo_init 
    9    !!             -   !  01-06  (M. Vancoppenolle) LIM 3.0 
    10    !!             -   !  06-08  (G. Madec)  cleaning for surface module 
     6   !! History :  8.0  ! 2001-04  (LIM 1.0) 
     7   !!   NEMO     1.0  ! 2003-07  (C. Ethe, G. Madec)  Optimization (old name:shine) 
     8   !!             -   ! 2004-11  (C. Talandier)  add albedo_init 
     9   !!             -   ! 2001-06  (M. Vancoppenolle) LIM 3.0 
     10   !!             -   ! 2006-08  (G. Madec)  cleaning for surface module 
     11   !!---------------------------------------------------------------------- 
     12 
    1113   !!---------------------------------------------------------------------- 
    1214   !!   albedo_ice  : albedo for   ice (clear and overcast skies) 
    … …  
    2022   PRIVATE 
    2123 
    22    PUBLIC albedo_ice   ! routine called sbcice_lim.F90 
    23    PUBLIC albedo_oce   ! routine called by ??? 
     24   PUBLIC   albedo_ice   ! routine called sbcice_lim.F90 
     25   PUBLIC   albedo_oce   ! routine called by ??? 
    2426 
    2527   INTEGER  ::   albd_init = 0      !: control flag for initialization 
    … …  
    3133   REAL(wp) ::   rmue   = 0.40    !  cosine of local solar altitude 
    3234 
    33    !!* namelist namalb 
    34    REAL(wp) ::   & 
    35       cgren  = 0.06  ,     &   !  cloudiness effect on snow or ice albedo (Grenfell & Perovich, 1984) 
     35   !                               !!* namelist namsbc_alb 
     36   REAL(wp) ::   rn_cloud  = 0.06   !  cloudiness effect on snow or ice albedo (Grenfell & Perovich, 1984) 
    3637#if defined key_lim3 
    37       albice = 0.53  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
     38   REAL(wp) ::   rn_albice = 0.53   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    3839#else 
    39       albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
     40   REAL(wp) ::   rn_albice = 0.50   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 
    4041#endif 
    41       alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute 
    42       alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972) 
    43       alphc  = 0.65  
    44  
    45    !!---------------------------------------------------------------------- 
    46    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     42   REAL(wp) ::   rn_alphd  = 0.80   !  coefficients for linear interpolation used to compute 
     43   REAL(wp) ::   rn_alphdi = 0.72   !  albedo between two extremes values (Pyane, 1972) 
     44   REAL(wp) ::   rn_alphc  = 0.65   !  
     45 
     46   !!---------------------------------------------------------------------- 
     47   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009)  
    4748   !! $Id$ 
    4849   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    8283      !! 
    8384      LOGICAL , DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   llmask 
    84       REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zalbfz    ! = alphdi for freezing ice ; = albice for melting ice 
     85      REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice 
    8586      REAL(wp), DIMENSION(jpi,jpj,SIZE(pt_ice,3)) ::   zficeth   !  function of ice thickness 
    8687      !!--------------------------------------------------------------------- 
    … …  
    9596      llmask = ( ph_snw == 0.e0 ) .AND. ( pt_ice >= rt0_ice ) 
    9697      ! ice free of snow and melts 
    97       WHERE( llmask )    
    98          zalbfz = albice 
    99       ELSEWHERE      
    100          zalbfz = alphdi 
     98      WHERE( llmask )   ;   zalbfz = rn_albice 
     99      ELSEWHERE         ;   zalbfz = rn_alphdi 
    101100      END WHERE 
    102101 
    … …  
    131130               !                                        !  freezing snow         
    132131               zihsc1   = 1.0 - MAX( zzero , SIGN( zone , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 
    133                zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                        & 
    134                   &                           + ph_snw(ji,jj,jl) * ( alphd - zficeth(ji,jj,jl) ) / c1  )   & 
    135                   &     +         zihsc1   * alphd   
     132               zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                             & 
     133                  &                           + ph_snw(ji,jj,jl) * ( rn_alphd - zficeth(ji,jj,jl) ) / c1  )   & 
     134                  &     +         zihsc1   * rn_alphd   
    136135               !                                        !  melting snow                 
    137136               zihsc2   = MAX( zzero , SIGN( zone , ph_snw(ji,jj,jl) - c2 ) ) 
    138                zalbpsnm = ( 1.0 - zihsc2 ) * ( albice + ph_snw(ji,jj,jl) * ( alphc - albice ) / c2 )       & 
    139                   &     +         zihsc2   * alphc  
     137               zalbpsnm = ( 1.0 - zihsc2 ) * ( rn_albice + ph_snw(ji,jj,jl) * ( rn_alphc - rn_albice ) / c2 )   & 
     138                  &     +         zihsc2   *   rn_alphc  
    140139               ! 
    141140               zitmlsn  =  MAX( zzero , SIGN( zone , pt_ice(ji,jj,jl) - rt0_snow ) )    
    … …  
    154153      !    Albedo of snow-ice for overcast sky. 
    155154      !----------------------------------------------   
    156       pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + cgren       ! Oberhuber correction 
     155      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction 
    157156      ! 
    158157   END SUBROUTINE albedo_ice 
    … …  
    186185      !! ** Purpose :   initializations for the albedo parameters 
    187186      !! 
    188       !! ** Method  :   Read the namelist namalb 
    189       !!---------------------------------------------------------------------- 
    190       NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 
    191       !!---------------------------------------------------------------------- 
    192  
    193       ! set the initialization flag to 1 
    194       albd_init = 1           ! indicate that the initialization has been done 
    195  
    196       ! Read Namelist namalb : albedo parameters 
    197       REWIND( numnam ) 
    198       READ  ( numnam, namalb ) 
    199  
    200       IF(lwp) THEN               ! Control print 
     187      !! ** Method  :   Read the namelist namsbc_alb 
     188      !!---------------------------------------------------------------------- 
     189      NAMELIST/namsbc_alb/ rn_cloud, rn_albice, rn_alphd, rn_alphdi, rn_alphc 
     190      !!---------------------------------------------------------------------- 
     191      ! 
     192      albd_init = 1                     ! indicate that the initialization has been done 
     193      ! 
     194      REWIND( numnam )                  ! Read Namelist namsbc_alb : albedo parameters 
     195      READ  ( numnam, namsbc_alb ) 
     196      ! 
     197      IF(lwp) THEN                      ! Control print 
    201198         WRITE(numout,*) 
    202          WRITE(numout,*) 'albedo_init : set albedo parameters from namelist namalb' 
    203          WRITE(numout,*) '~~~~~~~~~~~' 
    204          WRITE(numout,*) '             correction for snow and ice albedo                    cgren  = ', cgren 
    205          WRITE(numout,*) '             albedo of melting ice in the arctic and antarctic     albice = ', albice 
    206          WRITE(numout,*) '             coefficients for linear                               alphd  = ', alphd 
    207          WRITE(numout,*) '             interpolation used to compute albedo                  alphdi = ', alphdi 
    208          WRITE(numout,*) '             between two extremes values (Pyane, 1972)             alphc  = ', alphc 
     199         WRITE(numout,*) 'albedo : set albedo parameters' 
     200         WRITE(numout,*) '~~~~~~~' 
     201         WRITE(numout,*) '   Namelist namsbc_alb : albedo ' 
     202         WRITE(numout,*) '      correction for snow and ice albedo                  rn_cloud  = ', rn_cloud 
     203         WRITE(numout,*) '      albedo of melting ice in the arctic and antarctic   rn_albice = ', rn_albice 
     204         WRITE(numout,*) '      coefficients for linear                             rn_alphd  = ', rn_alphd 
     205         WRITE(numout,*) '      interpolation used to compute albedo                rn_alphdi = ', rn_alphdi 
     206         WRITE(numout,*) '      between two extremes values (Pyane, 1972)           rn_alphc  = ', rn_alphc 
    209207      ENDIF 
    210208      ! 

  • trunk/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r1482 r1601  
    5454   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf   ! structure of input fields (file informations, fields read) 
    5555          
    56    !! * CORE bulk parameters 
     56   !                                             !!! CORE bulk parameters 
    5757   REAL(wp), PARAMETER ::   rhoa =    1.22        ! air density 
    5858   REAL(wp), PARAMETER ::   cpa  = 1000.5         ! specific heat of air 
    … …  
    6262   REAL(wp), PARAMETER ::   Cice =    1.63e-3     ! transfer coefficient over ice 
    6363 
    64    LOGICAL  ::   ln_2m = .FALSE.                  !: logical flag for height of air temp. and hum 
    65    REAL(wp) ::   alpha_precip=1.                  !: multiplication factor for precipitation 
     64   !                                !!* Namelist namsbc_core : CORE bulk parameters 
     65   LOGICAL  ::   ln_2m = .FALSE.     ! logical flag for height of air temp. and hum 
     66   REAL(wp) ::   rn_pfac = 1.        ! multiplication factor for precipitation 
    6667 
    6768   !! * Substitutions 
    … …  
    115116      TYPE(FLD_N) ::   sn_wndi, sn_wndj, sn_humi, sn_qsr       ! informations about the fields to be read 
    116117      TYPE(FLD_N) ::   sn_qlw , sn_tair, sn_prec, sn_snow      !   "                                 " 
    117       NAMELIST/namsbc_core/ cn_dir, ln_2m, alpha_precip, sn_wndi, sn_wndj, sn_humi, sn_qsr,   & 
    118          &                                               sn_qlw , sn_tair, sn_prec, sn_snow 
     118      NAMELIST/namsbc_core/ cn_dir, ln_2m, rn_pfac, sn_wndi, sn_wndj, sn_humi, sn_qsr,   & 
     119         &                                                sn_qlw , sn_tair, sn_prec, sn_snow 
    119120      !!--------------------------------------------------------------------- 
    120121 
    … …  
    124125         ! set file information (default values) 
    125126         cn_dir = './'       ! directory in which the model is executed 
    126  
     127         ! 
    127128         ! (NB: frequency positive => hours, negative => months) 
    128129         !            !    file     ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    … …  
    136137         sn_prec = FLD_N( 'precip'  ,    -1.    ,  'precip'  ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
    137138         sn_snow = FLD_N( 'snow'    ,    -1.    ,  'snow'    ,  .true.    , .false. ,   'yearly'  , ''       , ''         ) 
    138  
     139         ! 
    139140         REWIND( numnam )                    ! ... read in namlist namsbc_core 
    140141         READ  ( numnam, namsbc_core ) 
    141  
     142         ! 
    142143         ! store namelist information in an array 
    143144         slf_i(jp_wndi) = sn_wndi   ;   slf_i(jp_wndj) = sn_wndj 
    … …  
    145146         slf_i(jp_tair) = sn_tair   ;   slf_i(jp_humi) = sn_humi 
    146147         slf_i(jp_prec) = sn_prec   ;   slf_i(jp_snow) = sn_snow 
    147           
     148         ! 
    148149         ! set sf structure 
    149150         ALLOCATE( sf(jpfld), STAT=ierror ) 
    … …  
    151152            CALL ctl_stop( 'sbc_blk_core: unable to allocate sf structure' )   ;   RETURN 
    152153         ENDIF 
    153  
    154154         DO ifpr= 1, jpfld 
    155155            ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 
    156156            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 
    157157         END DO 
    158  
     158         ! 
    159159         ! fill sf with slf_i and control print 
    160160         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_core', 'flux formulattion for ocean surface boundary condition', 'namsbc_core' ) 
    161161         ! 
    162162      ENDIF 
    163  
    164163 
    165164      CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step 
    … …  
    327326      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux 
    328327!CDIR COLLAPSE 
    329       emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * alpha_precip * tmask(:,:,1) 
     328      emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * rn_pfac * tmask(:,:,1) 
    330329!CDIR COLLAPSE 
    331330      emps(:,:) = emp(:,:) 
    … …  
    533532        
    534533!CDIR COLLAPSE 
    535       p_tpr(:,:) = sf(jp_prec)%fnow(:,:) * alpha_precip      ! total precipitation [kg/m2/s] 
    536 !CDIR COLLAPSE 
    537       p_spr(:,:) = sf(jp_snow)%fnow(:,:) * alpha_precip      ! solid precipitation [kg/m2/s] 
    538       CALL iom_put( 'snowpre', p_spr )                       ! Snow precipitation  
     534      p_tpr(:,:) = sf(jp_prec)%fnow(:,:) * rn_pfac      ! total precipitation [kg/m2/s] 
     535!CDIR COLLAPSE 
     536      p_spr(:,:) = sf(jp_snow)%fnow(:,:) * rn_pfac      ! solid precipitation [kg/m2/s] 
     537      CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation  
    539538      ! 
    540539      IF(ln_ctl) THEN 

  • trunk/NEMO/OPA_SRC/SBC/sbcmod.F90

    r1482 r1601  
    115115         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr      = ', ln_ssr 
    116116         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb 
    117          WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nclosea     = ', nclosea 
     117         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea   = ', nn_closea 
    118118      ENDIF 
    119119 

  • trunk/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r1540 r1601  
    3737   REAL(wp)          , PUBLIC ::   rn_hrnf      = 0.e0    !: runoffs, depth over which enhanced vertical mixing is used 
    3838   REAL(wp)          , PUBLIC ::   rn_avt_rnf   = 0.e0    !: runoffs, value of the additional vertical mixing coef. [m2/s] 
    39    REAL(wp)          , PUBLIC ::   rn_mul_rnf   = 1.e0    !: multiplicative factor for runoff 
     39   REAL(wp)          , PUBLIC ::   rn_rfact     = 1.e0    !: multiplicative factor for runoff 
    4040 
    4141   INTEGER , PUBLIC                     ::   nkrnf = 0   !: number of levels over which Kz is increased at river mouths 
    … …  
    103103 
    104104         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    105             emp (:,:) = emp (:,:) - rn_mul_rnf * ABS( sf_rnf(1)%fnow(:,:) ) 
    106             emps(:,:) = emps(:,:) - rn_mul_rnf * ABS( sf_rnf(1)%fnow(:,:) ) 
     105            emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
     106            emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
    107107            CALL iom_put( "runoffs", sf_rnf(1)%fnow )         ! runoffs 
    108108         ENDIF 
    … …  
    126126      !! 
    127127      NAMELIST/namsbc_rnf/ cn_dir, ln_rnf_emp, sn_rnf, sn_cnf, ln_rnf_mouth,   & 
    128          &                 rn_hrnf, rn_avt_rnf, rn_mul_rnf 
     128         &                 rn_hrnf, rn_avt_rnf, rn_rfact 
    129129      !!---------------------------------------------------------------------- 
    130130 
    … …  
    152152         WRITE(numout,*) '      river mouth additional Kz                  rn_avt_rnf   = ', rn_avt_rnf 
    153153         WRITE(numout,*) '      depth of river mouth additional mixing     rn_hrnf      = ', rn_hrnf 
    154          WRITE(numout,*) '      multiplicative factor for runoff           rn_mul_rnf   = ', rn_mul_rnf   
     154         WRITE(numout,*) '      multiplicative factor for runoff           rn_rfact     = ', rn_rfact     
    155155      ENDIF 
    156156 
    … …  
    228228      !!                rnfmsk_z vertical structure 
    229229      !!---------------------------------------------------------------------- 
    230       USE closea, ONLY :    nclosea, clo_rnf   ! closed sea flag, rnfmsk update routine 
     230      USE closea, ONLY :    clo_rnf   ! rnfmsk update routine 
    231231      ! 
    232232      INTEGER           ::   inum        ! temporary integers 

  • trunk/NEMO/OPA_SRC/SBC/sbcssr.F90

    r1573 r1601  
    3232   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qrp      !: heat flux damping        [w/m2] 
    3333 
    34    !                                      !!* Namelist namsbc_ssr * 
    35    INTEGER, PUBLIC ::   nn_sstr, nn_sssr   ! SST/SSS restoring indicator 
    36    REAL(wp)        ::   dqdt, deds         ! restoring factor on SST and SSS 
    37    LOGICAL         ::   ln_sssr_bnd        ! flag to bound erp term  
    38    REAL(wp)        ::   rn_sssr_bnd        ! ABS(Max./Min.) value of erp term [mm/day] 
     34   !                                           !!* Namelist namsbc_ssr * 
     35   INTEGER, PUBLIC ::   nn_sstr     =   0       ! SST/SSS restoring indicator 
     36   INTEGER, PUBLIC ::   nn_sssr     =   0       ! SST/SSS restoring indicator 
     37   REAL(wp)        ::   rn_dqdt     = -40.e0    ! restoring factor on SST and SSS 
     38   REAL(wp)        ::   rn_deds     = -27.70    ! restoring factor on SST and SSS 
     39   LOGICAL         ::   ln_sssr_bnd = .false.   ! flag to bound erp term  
     40   REAL(wp)        ::   rn_sssr_bnd =   0.e0    ! ABS(Max./Min.) value of erp term [mm/day] 
    3941 
    4042   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange 
    … …  
    7173      REAL(wp) ::   zerp     ! local scalar for evaporation damping 
    7274      REAL(wp) ::   zqrp     ! local scalar for heat flux damping 
    73       REAL(wp) ::   zsrp     ! local scalar for unit conversion of deds factor 
     75      REAL(wp) ::   zsrp     ! local scalar for unit conversion of rn_deds factor 
    7476      REAL(wp) ::   zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 
    7577      INTEGER  ::   ierror   ! return error code 
    … …  
    7779      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    7880      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    79       NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, dqdt, deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
     81      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
    8082      !!---------------------------------------------------------------------- 
    8183      ! 
    … …  
    8385      IF( kt == nit000 ) THEN                         ! First call kt=nit000 ! 
    8486         !                                            ! -------------------- ! 
    85          nn_sstr = 0                  !* set file information 
    86          nn_sssr = 0 
    87          dqdt    = -40.e0 
    88          deds    = -27.70 
     87         !                            !* set file information 
    8988         cn_dir  = './'            ! directory in which the model is executed 
    9089         ! ... default values (NB: frequency positive => hours, negative => months) 
    … …  
    101100            WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 
    102101            WRITE(numout,*) '~~~~~~~ ' 
    103             WRITE(numout,*) '          SST restoring term (Yes=1)             nn_sstr = ', nn_sstr 
    104             WRITE(numout,*) '          SSS damping term (Yes=1, salt flux)    nn_sssr = ', nn_sssr 
    105             WRITE(numout,*) '                           (Yes=2, volume flux) ' 
    106             WRITE(numout,*) '          dQ/dT (restoring magnitude on SST)     dqdt    = ', dqdt, ' W/m2/K' 
    107             WRITE(numout,*) '          dE/dS (restoring magnitude on SST)     deds    = ', deds, ' mm/day' 
    108             WRITE(numout,*) '          flag to bound erp term             ln_sssr_bnd = ', ln_sssr_bnd 
    109             WRITE(numout,*) '          ABS(Max./Min.) erp threshold       rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
     102            WRITE(numout,*) '   Namelist namsbc_ssr :' 
     103            WRITE(numout,*) '      SST restoring term (Yes=1)             nn_sstr     = ', nn_sstr 
     104            WRITE(numout,*) '      SSS damping term (Yes=1, salt flux)    nn_sssr     = ', nn_sssr 
     105            WRITE(numout,*) '                       (Yes=2, volume flux) ' 
     106            WRITE(numout,*) '      dQ/dT (restoring magnitude on SST)     rn_dqdt     = ', rn_dqdt, ' W/m2/K' 
     107            WRITE(numout,*) '      dE/dS (restoring magnitude on SST)     rn_deds     = ', rn_deds, ' mm/day' 
     108            WRITE(numout,*) '      flag to bound erp term                 ln_sssr_bnd = ', ln_sssr_bnd 
     109            WRITE(numout,*) '      ABS(Max./Min.) erp threshold           rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 
    110110         ENDIF 
    111111 
    … …  
    154154               DO jj = 1, jpj 
    155155                  DO ji = 1, jpi 
    156                      zqrp = dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) ) 
     156                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) ) 
    157157                     qns(ji,jj) = qns(ji,jj) + zqrp 
    158158                     qrp(ji,jj) = zqrp 
    … …  
    163163            ! 
    164164            IF( nn_sssr == 1 ) THEN                   !* Salinity damping term (salt flux, emps only) 
    165                zsrp = deds / rday                                     ! from [mm/day] to [kg/m2/s] 
     165               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    166166!CDIR COLLAPSE 
    167167               DO jj = 1, jpj 
    … …  
    175175               END DO 
    176176               CALL iom_put( "erp", erp )                             ! freshwater flux damping 
     177               ! 
    177178            ELSEIF( nn_sssr == 2 ) THEN               !* Salinity damping term (volume flux, emp and emps) 
    178                zsrp = deds / rday                                     ! from [mm/day] to [kg/m2/s] 
     179               zsrp = rn_deds / rday                                  ! from [mm/day] to [kg/m2/s] 
    179180               zerp_bnd = rn_sssr_bnd / rday                          !       -              -     
    180181!CDIR COLLAPSE 

  • trunk/NEMO/OPA_SRC/SOL/sol_oce.F90

    r1556 r1601  
    22   !!====================================================================== 
    33   !!                    ***  MODULE  sol_oce  *** 
    4    !! Ocean solver :  solver variables defined in memory  
    5    !!===================================================================== 
    6    !! 
    7    !! ** Purpose :   Define in memory solver variables 
    8    !! 
    9    !! History : 
    10    !!   9.0  !  02-11  (G. Madec)  F90: Free form and module 
     4   !! Ocean solver :  elliptic solver variables defined in memory  
     5   !!====================================================================== 
     6   !! History :  1.0  !  02-11  (G. Madec)  F90: Free form and module 
    117   !!---------------------------------------------------------------------- 
    12    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    13    !! $Id$  
    14    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    15    !!---------------------------------------------------------------------- 
    16    !! * Modules used 
    178   USE par_oce         ! ocean parameters 
    189 
    … …  
    2011   PRIVATE 
    2112 
    22    !!---------------------------- 
    23    !! elliptic solver: SOR or PCG 
    24    !! --------------------------- 
    25    INTEGER , PUBLIC ::      & !!: namsol   elliptic solver / free surface 
    26       nsolv    =    1 ,     &  !: = 1/2 type of elliptic solver 
    27       nsol_arp =    0 ,     &  !: = 0/1 absolute/relative precision convergence test 
    28       nmin     =  300 ,     &  !: minimum of iterations for the SOR solver 
    29       nmax     =  800 ,     &  !: maximum of iterations for the SOR solver 
    30       nmod     =   10          !: frequency of test for the SOR solver 
    31       
    32    REAL(wp), PUBLIC ::      & !!: namsol   elliptic solver / free surface 
    33       eps    =  1.e-6_wp ,  &  !: absolute precision of the solver 
    34       resmax = 1.e-14_wp ,  &  !: absolute precision for the SOR solver 
    35       sor    =   1.92_wp ,  &  !: optimal coefficient for the SOR solver 
    36       rnu    =    1.0_wp       !: strength of the additional force used in free surface 
     13   !                                             !!* Namelist namsol : elliptic solver * 
     14   INTEGER , PUBLIC ::   nn_solv    =    1        !: = 1/2 type of elliptic solver 
     15   INTEGER , PUBLIC ::   nn_sol_arp =    0        !: = 0/1 absolute/relative precision convergence test 
     16   INTEGER , PUBLIC ::   nn_nmin    =  300        !: minimum of iterations for the SOR solver 
     17   INTEGER , PUBLIC ::   nn_nmax    =  800        !: maximum of iterations for the SOR solver 
     18   INTEGER , PUBLIC ::   nn_nmod    =   10        !: frequency of test for the SOR solver 
     19   REAL(wp), PUBLIC ::   rn_eps     =  1.e-6_wp   !: absolute precision of the solver 
     20   REAL(wp), PUBLIC ::   rn_resmax  = 1.e-14_wp   !: absolute precision for the SOR solver 
     21   REAL(wp), PUBLIC ::   rn_sor     =   1.92_wp   !: optimal coefficient for the SOR solver 
     22   REAL(wp), PUBLIC ::   rn_nu      =    1.0_wp   !: strength of the additional force used in free surface 
    3723 
    38    CHARACTER(len=1), PUBLIC ::   &  !: 
    39       c_solver_pt = 'T'        !: nature of grid-points T (S) for free surface case 
     24   CHARACTER(len=1), PUBLIC ::   c_solver_pt = 'T'   !: nature of grid-points T (S) for free surface case 
    4025 
    41    INTEGER , PUBLIC ::   &  !: 
    42       ncut,         &  !: indicator of solver convergence 
    43       niter            !: number of iteration done by the solver 
     26   INTEGER , PUBLIC ::   ncut        !: indicator of solver convergence 
     27   INTEGER , PUBLIC ::   niter       !: number of iteration done by the solver 
    4428 
    45    REAL(wp), PUBLIC ::   &  !: 
    46       epsr,         &  !: relative precision for SOR & PCG solvers 
    47       rnorme, res,  &  !: intermediate modulus, solver residu 
    48       alph,         &  !: coefficient  =(gcr,gcr)/(gcx,gccd) 
    49       beta,         &  !: coefficient  =(rn+1,rn+1)/(rn,rn) 
    50       radd,         &  !: coefficient  =(gccd,gcdes) 
    51       rr               !: coefficient  =(rn,rn) 
     29   REAL(wp), PUBLIC ::   eps, epsr   !: relative precision for SOR & PCG solvers 
     30   REAL(wp), PUBLIC ::   rnorme      !: intermediate modulus 
     31   REAL(wp), PUBLIC ::   res         !: solver residu 
     32   REAL(wp), PUBLIC ::   alph        !: coefficient  =(gcr,gcr)/(gcx,gccd) 
     33   REAL(wp), PUBLIC ::   beta        !: coefficient  =(rn+1,rn+1)/(rn,rn) 
     34   REAL(wp), PUBLIC ::   radd        !: coefficient  =(gccd,gcdes) 
     35   REAL(wp), PUBLIC ::   rr          !: coefficient  =(rn,rn) 
    5236 
    53    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   &  !: 
    54       gcp              !: barotropic matrix extra-diagonal elements 
    55  
    56    REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) ::   &  !: 
    57       gcx, gcxb,    &  !: now, before solution of the elliptic equation 
    58       gcdprc,       &  !: inverse diagonal preconditioning matrix 
    59       gcdmat,       &  !: diagonal preconditioning matrix 
    60       gcb,          &  !: second member of the barotropic linear system 
    61       gcr,          &  !: residu =b-a.x 
    62       gcdes,        &  !: vector descente 
    63       gccd             !: vector such that ca.gccd=a.d (ca-1=gcdprc) 
     37   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   gcp     !: matrix extra-diagonal elements 
     38   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcx     !: now    solution of the elliptic eq. 
     39   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcxb    !: before solution of the elliptic eq. 
     40   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdprc  !: inverse diagonal preconditioning matrix 
     41   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdmat  !: diagonal preconditioning matrix 
     42   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcb     !: second member of the elliptic eq. 
     43   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcr     !: residu =b-a.x 
     44   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gcdes   !: vector descente 
     45   REAL(wp), PUBLIC, DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)   ::   gccd    !: gccd= gcdprc^-1.a.d  
    6446 
    6547#if defined key_agrif 
    … …  
    6850 
    6951   !!---------------------------------------------------------------------- 
     52   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     53   !! $Id$  
     54   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     55   !!---------------------------------------------------------------------- 
    7056END MODULE sol_oce 

  • trunk/NEMO/OPA_SRC/SOL/solmat.F90

    r1566 r1601  
    44   !! solver       : construction of the matrix  
    55   !!====================================================================== 
    6    !! History :   1.0  !  88-04  (G. Madec)  Original code 
    7    !!                  !  93-03  (M. Guyon)  symetrical conditions 
    8    !!                  !  93-06  (M. Guyon)  suppress pointers 
    9    !!                  !  96-05  (G. Madec)  merge sor and pcg formulations 
    10    !!                  !  96-11  (A. Weaver)  correction to preconditioning 
    11    !!             8.5  !  02-08  (G. Madec)  F90: Free form 
    12    !!                  !  02-11  (C. Talandier, A-M. Treguier) Free surface & Open boundaries 
    13    !!             9.0  !  05-09  (R. Benshila)  add sol_exd for extra outer halo 
    14    !!             9.0  !  05-11  (V. Garnier) Surface pressure gradient organization 
    15    !!             9.0  !  06-07  (S. Masson)  distributed restart using iom 
    16    !!---------------------------------------------------------------------- 
    17  
    18    !!---------------------------------------------------------------------- 
    19    !!   sol_mat       : Construction of the matrix of used by the elliptic solvers 
    20    !!   fetsch        : 
    21    !!   fetmat        : 
    22    !!   fetstr        : 
    23    !!---------------------------------------------------------------------- 
    24    !! * Modules used 
     6   !! History :   1.0  ! 1988-04  (G. Madec)  Original code 
     7   !!                  ! 1993-03  (M. Guyon)  symetrical conditions 
     8   !!                  ! 1993-06  (M. Guyon)  suppress pointers 
     9   !!                  ! 1996-05  (G. Madec)  merge sor and pcg formulations 
     10   !!                  ! 1996-11  (A. Weaver)  correction to preconditioning 
     11   !!   NEMO      1.0  ! 1902-08  (G. Madec)  F90: Free form 
     12   !!              -   ! 1902-11  (C. Talandier, A-M. Treguier) Free surface & Open boundaries 
     13   !!             2.0  ! 2005-09  (R. Benshila)  add sol_exd for extra outer halo 
     14   !!              -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
     15   !!             3.2  ! 2009-06  (S. Masson)  distributed restart using iom 
     16   !!              -   ! 2009-07  (R. Benshila)  suppression of rigid-lid option 
     17   !!---------------------------------------------------------------------- 
     18 
     19   !!---------------------------------------------------------------------- 
     20   !!   sol_mat : Construction of the matrix of used by the elliptic solvers 
     21   !!   sol_exd : 
     22   !!---------------------------------------------------------------------- 
    2523   USE oce             ! ocean dynamics and active tracers 
    2624   USE dom_oce         ! ocean space and time domain 
    … …  
    3533   PRIVATE 
    3634 
    37    !! * Routine accessibility 
    38    PUBLIC sol_mat     ! routine called by inisol.F90 
    39    !!---------------------------------------------------------------------- 
    40    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     35   PUBLIC   sol_mat    ! routine called by inisol.F90 
     36 
     37   !!---------------------------------------------------------------------- 
     38   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    4139   !! $Id$  
    4240   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    … …  
    5048      !! 
    5149      !! ** Purpose :   Construction of the matrix of used by the elliptic  
    52       !!      solvers (either sor or pcg methods). 
    53       !! 
    54       !! ** Method  :   
    55       !!      lk_dynspg_flt=T: free surface formulation 
    56       !!      The matrix is built for the divergence of the transport system 
    57       !!      a diagonal preconditioning matrix is also defined. 
     50      !!              solvers (either sor or pcg methods). 
     51      !! 
     52      !! ** Method  :   The matrix is built for the divergence of the transport  
     53      !!              system. a diagonal preconditioning matrix is also defined. 
    5854      !!  
    5955      !! ** Action  : - gcp    : extra-diagonal elements of the matrix 
    … …  
    6157      !!              - gcdprc : inverse of the preconditioning matrix 
    6258      !!---------------------------------------------------------------------- 
    63       !! * Arguments 
    6459      INTEGER, INTENT(in) :: kt 
    65  
    66       !! * Local declarations 
     60      !! 
    6761      INTEGER ::   ji, jj                    ! dummy loop indices 
    6862      REAL(wp) ::   zcoefs, zcoefw, zcoefe, zcoefn  ! temporary scalars 
    … …  
    7367      ! 1. Construction of the matrix 
    7468      ! ----------------------------- 
    75        
    76       ! initialize to zero 
    77       zcoef = 0.e0 
     69      zcoef = 0.e0                          ! initialize to zero 
    7870      gcp(:,:,1) = 0.e0 
    7971      gcp(:,:,2) = 0.e0 
    8072      gcp(:,:,3) = 0.e0 
    8173      gcp(:,:,4) = 0.e0 
    82        
     74      ! 
    8375      gcdprc(:,:) = 0.e0 
    8476      gcdmat(:,:) = 0.e0 
    85        
    86       IF( neuler == 0 .AND. kt == nit000 ) THEN 
    87          z2dt = rdt 
    88       ELSE 
    89          z2dt = 2. * rdt 
     77      ! 
     78      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   z2dt = rdt 
     79      ELSE                                        ;   z2dt = 2. * rdt 
    9080      ENDIF 
    9181 
    9282#if defined key_dynspg_flt && ! defined key_obc 
    93 !!cr      IF( lk_dynspg_flt .AND. .NOT.lk_obc ) THEN   !bug missing lk_dynspg_flt_atsk 
    94  
    95       ! defined the coefficients for free surface elliptic system 
    96  
    97       DO jj = 2, jpjm1 
     83 
     84      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system 
    9885         DO ji = 2, jpim1 
    99             zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 
     86            zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    10087            zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient 
    10188            zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient 
    … …  
    11299       
    113100#  elif defined key_dynspg_flt && defined key_obc 
    114 !!cr      ELSEIF( lk_dynspg_flt .AND. lk_obc ) THEN     !bug missing lk_dynspg_flt_atsk  
    115  
    116       !   defined gcdmat in the case of open boundaries 
    117  
    118       DO jj = 2, jpjm1 
     101 
     102      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system with open boundaries 
    119103         DO ji = 2, jpim1 
    120             zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 
    121             !  south coefficient 
     104            zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
     105            !                                    ! south coefficient 
    122106            IF( lp_obc_south .AND. ( jj == njs0p1 ) ) THEN 
    123107               zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vsmsk(ji,1)) 
    … …  
    126110            END IF 
    127111            gcp(ji,jj,1) = zcoefs 
    128  
    129             !  west coefficient 
     112            ! 
     113            !                                    ! west coefficient 
    130114            IF( lp_obc_west  .AND. ( ji == niw0p1 ) ) THEN 
    131115               zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-uwmsk(jj,1)) 
    … …  
    134118            END IF 
    135119            gcp(ji,jj,2) = zcoefw 
    136  
    137             !   east coefficient 
     120            ! 
     121            !                                    ! east coefficient 
    138122            IF( lp_obc_east  .AND. ( ji == nie0 ) ) THEN 
    139123               zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-uemsk(jj,1)) 
    … …  
    142126            END IF 
    143127            gcp(ji,jj,3) = zcoefe 
    144  
    145             !   north coefficient 
     128            ! 
     129            !                                    ! north coefficient 
    146130            IF( lp_obc_north .AND. ( jj == njn0 ) ) THEN 
    147131               zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vnmsk(ji,1)) 
    … …  
    150134            END IF 
    151135            gcp(ji,jj,4) = zcoefn 
    152  
    153             ! diagonal coefficient 
    154             gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 
    155                             - zcoefs -zcoefw -zcoefe -zcoefn 
     136            ! 
     137            !                                    ! diagonal coefficient 
     138            gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   & 
     139               &            - zcoefs -zcoefw -zcoefe -zcoefn 
    156140         END DO 
    157141      END DO 
    158  
    159 #  else 
    160 !!cr      ELSE 
    161  
    162       !   defined the coefficients for bsf elliptic system 
    163        
    164       DO jj = 2, jpjm1 
    165          DO ji = 2, jpim1 
    166             zcoefs = -hur(ji  ,jj  ) * e1u(ji  ,jj  ) / e2u(ji  ,jj  ) * bmask(ji,jj)   ! south coefficient 
    167             zcoefw = -hvr(ji  ,jj  ) * e2v(ji  ,jj  ) / e1v(ji  ,jj  ) * bmask(ji,jj)   ! west coefficient 
    168             zcoefe = -hvr(ji+1,jj  ) * e2v(ji+1,jj  ) / e1v(ji+1,jj  ) * bmask(ji,jj)   ! east coefficient 
    169             zcoefn = -hur(ji  ,jj+1) * e1u(ji  ,jj+1) / e2u(ji  ,jj+1) * bmask(ji,jj)   ! north coefficient 
    170             gcp(ji,jj,1) = zcoefs 
    171             gcp(ji,jj,2) = zcoefw 
    172             gcp(ji,jj,3) = zcoefe 
    173             gcp(ji,jj,4) = zcoefn 
    174             gcdmat(ji,jj) = -zcoefs -zcoefw -zcoefe -zcoefn                             ! diagonal coefficient 
     142#endif 
     143 
     144#if defined key_agrif 
     145      IF( .NOT.AGRIF_ROOT() ) THEN 
     146         ! 
     147         IF( nbondi == -1 .OR. nbondi == 2 )   bmask(2     ,:     ) = 0.e0 
     148         IF( nbondi ==  1 .OR. nbondi == 2 )   bmask(nlci-1,:     ) = 0.e0 
     149         IF( nbondj == -1 .OR. nbondj == 2 )   bmask(:     ,2     ) = 0.e0 
     150         IF( nbondj ==  1 .OR. nbondj == 2 )   bmask(:     ,nlcj-1) = 0.e0 
     151         ! 
     152         DO jj = 2, jpjm1 
     153            DO ji = 2, jpim1 
     154               zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
     155               !  south coefficient 
     156               IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN 
     157                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
     158               ELSE 
     159                  zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
     160               END IF 
     161               gcp(ji,jj,1) = zcoefs 
     162               !  
     163               !  west coefficient 
     164               IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 )  ) THEN 
     165                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
     166               ELSE 
     167                  zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
     168               END IF 
     169               gcp(ji,jj,2) = zcoefw 
     170               ! 
     171               !   east coefficient 
     172               IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN 
     173                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1)) 
     174               ELSE 
     175                  zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
     176               END IF 
     177               gcp(ji,jj,3) = zcoefe 
     178               ! 
     179               !   north coefficient 
     180               IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN 
     181                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
     182               ELSE 
     183                  zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
     184               END IF 
     185               gcp(ji,jj,4) = zcoefn 
     186               ! 
     187               ! diagonal coefficient 
     188               gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj)   & 
     189                  &            - zcoefs -zcoefw -zcoefe -zcoefn 
     190            END DO 
    175191         END DO 
    176       END DO 
    177        
    178 !!cr  ENDIF 
    179 #endif 
    180 #if defined key_agrif 
    181        IF (.NOT.AGRIF_ROOT()) THEN 
    182         
    183        IF ( (nbondi == -1)  .OR. (nbondi == 2) ) bmask(2,:)=0. 
    184        IF ( (nbondi ==  1)  .OR. (nbondi == 2) ) bmask(nlci-1,:)=0. 
    185        IF ( (nbondj == -1)  .OR. (nbondj == 2) ) bmask(:,2)=0. 
    186        IF ( (nbondj ==  1)  .OR. (nbondj == 2) ) bmask(:,nlcj-1)=0. 
    187  
    188       DO jj = 2, jpjm1 
    189          DO ji = 2, jpim1 
    190             zcoef = z2dt * z2dt * grav * rnu * bmask(ji,jj) 
    191             !  south coefficient 
    192             IF( ((nbondj == -1)  .OR. (nbondj == 2)) .AND. ( jj == 3 ) ) THEN 
    193                zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 
    194             ELSE 
    195                zcoefs = -zcoef * hv(ji,jj-1) * e1v(ji,jj-1)/e2v(ji,jj-1) 
    196             END IF 
    197             gcp(ji,jj,1) = zcoefs 
    198  
    199             !  west coefficient 
    200        IF( ( (nbondi == -1)  .OR. (nbondi == 2) ) .AND. ( ji == 3 )  ) THEN 
    201                zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 
    202             ELSE 
    203                zcoefw = -zcoef * hu(ji-1,jj) * e2u(ji-1,jj)/e1u(ji-1,jj) 
    204             END IF 
    205             gcp(ji,jj,2) = zcoefw 
    206  
    207             !   east coefficient 
    208             IF( ((nbondi == 1)  .OR. (nbondi == 2)) .AND. ( ji == nlci-2 ) ) THEN 
    209                zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1)) 
    210             ELSE 
    211                zcoefe = -zcoef * hu(ji,jj) * e2u(ji,jj)/e1u(ji,jj) 
    212             END IF 
    213             gcp(ji,jj,3) = zcoefe 
    214  
    215             !   north coefficient 
    216             IF( ((nbondj == 1)  .OR. (nbondj == 2)) .AND. ( jj == nlcj-2 ) ) THEN 
    217                zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1)) 
    218             ELSE 
    219                zcoefn = -zcoef * hv(ji,jj) * e1v(ji,jj)/e2v(ji,jj) 
    220             END IF 
    221             gcp(ji,jj,4) = zcoefn 
    222  
    223             ! diagonal coefficient 
    224             gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 
    225                             - zcoefs -zcoefw -zcoefe -zcoefn 
    226          END DO 
    227       END DO 
    228        
    229        ENDIF 
     192         !  
     193      ENDIF 
    230194#endif 
    231195 
    … …  
    244208      ! the diagonal coefficient of the southern grid points must be modify to 
    245209      ! account for the existence of the south symmetric bassin. 
    246        
    247 !!cr      IF( .NOT.lk_dynspg_flt ) THEN   !bug missing lk_dynspg_flt_atsk 
    248 #if ! defined key_dynspg_flt 
    249       IF( nperio == 2 ) THEN 
    250          DO ji = 1, jpi 
    251             IF( bmask(ji,2) /= 0.e0 ) THEN 
    252                zcoefs = - hur(ji,2)*e1u(ji,2)/e2u(ji,2) 
    253                gcdmat(ji,2) = gcdmat(ji,2) - zcoefs 
    254             ENDIF 
    255          END DO 
    256       ENDIF 
    257 !!cr      ENDIF 
    258 #endif 
    259210       
    260211      ! North fold boundary condition 
    … …  
    276227      gcp(:,:,3) = gcp(:,:,3) * gcdprc(:,:) 
    277228      gcp(:,:,4) = gcp(:,:,4) * gcdprc(:,:) 
    278       IF( nsolv == 2 )  gccd(:,:) = sor * gcp(:,:,2) 
    279  
    280       IF( nsolv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0) THEN 
     229      IF( nn_solv == 2 )  gccd(:,:) = rn_sor * gcp(:,:,2) 
     230 
     231      IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0) THEN 
    281232         CALL lbc_lnk_e( gcp   (:,:,1), c_solver_pt, 1. )   ! lateral boundary conditions 
    282233         CALL lbc_lnk_e( gcp   (:,:,2), c_solver_pt, 1. )   ! lateral boundary conditions 
    … …  
    308259      !!                the total area strictly above the pivot point, 
    309260      !!                and on the semi-row of the pivot point    
    310       !!                 
    311       !! History : 
    312       !!   9.0  !  05-09  (R. Benshila)  original routine 
    313       !!---------------------------------------------------------------------- 
    314       !! * Arguments 
    315       CHARACTER(len=1) , INTENT( in ) ::   & 
    316          cd_type       ! define the nature of pt2d array grid-points 
    317          !             !  = T , U , V , F , W  
    318          !             !  = S : T-point, north fold treatment 
    319          !             !  = G : F-point, north fold treatment 
    320          !             !  = I : sea-ice velocity at F-point with index shift 
    321       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), INTENT( inout ) ::   & 
    322          pt3d          ! 2D array on which the boundary condition is applied 
    323  
    324       !! * Local variables 
    325       INTEGER  ::   ji, jk      ! dummy loop indices 
    326       INTEGER  ::   iloc                ! temporary integers 
    327       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   & 
    328          ztab          ! 2D array on which the boundary condition is applied 
     261      !!---------------------------------------------------------------------- 
     262      CHARACTER(len=1) , INTENT( in ) ::   cd_type   ! define the nature of pt2d array grid-points 
     263         !                                           !  = T , U , V , F , W  
     264         !                                           !  = S : T-point, north fold treatment 
     265         !                                           !  = G : F-point, north fold treatment 
     266         !                                           !  = I : sea-ice velocity at F-point with index shift 
     267      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4), INTENT(inout) ::   pt3d   ! 2D field to be treated 
     268      !! 
     269      INTEGER  ::   ji, jk   ! dummy loop indices 
     270      INTEGER  ::   iloc     ! temporary integers 
     271      REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj,4) ::   ztab   ! 2D workspace 
    329272      !!---------------------------------------------------------------------- 
    330273 
    331274      ztab = pt3d 
    332275 
    333       ! north fold treatment 
    334       ! ----------------------- 
    335    
    336       SELECT CASE ( npolj ) 
    337           
    338          CASE ( 3 , 4 )   !  T pivot 
     276      SELECT CASE ( npolj )            ! north fold type 
     277      !  
     278      CASE ( 3 , 4 )                        !==  T pivot  ==! 
    339279         iloc = jpiglo/2 +1  
    340              
    341             SELECT CASE ( cd_type ) 
    342    
    343             CASE ( 'T', 'S', 'U', 'W' ) 
    344                DO jk =1, 4 
    345                   DO ji = 1-jpr2di, nlci+jpr2di 
    346                      pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
    347                   ENDDO 
    348                ENDDO 
    349  
    350               DO jk =1, 4 
    351                   DO ji = nlci+jpr2di, 1-jpr2di,  -1 
    352                      IF( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) & 
    353                        & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT 
     280         !    
     281         SELECT CASE ( cd_type ) 
     282         !  
     283         CASE ( 'T', 'S', 'U', 'W' ) 
     284            DO jk = 1, 4 
     285               DO ji = 1-jpr2di, nlci+jpr2di 
     286                  pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
     287               END DO 
     288            END DO 
     289            DO jk =1, 4 
     290               DO ji = nlci+jpr2di, 1-jpr2di,  -1 
     291                  IF( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) & 
     292                     & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT 
    354293                     pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4)) 
    355                   ENDDO 
    356                ENDDO 
    357  
    358             CASE ( 'F' ,'G' , 'I', 'V' ) 
    359                DO jk =1, 4 
    360                   DO ji = 1-jpr2di, nlci+jpr2di 
    361                      pt3d(ji,nlcj-1:nlcj+jpr2dj,jk) = ztab(ji,nlcj-1:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
    362                   ENDDO 
    363                ENDDO 
    364  
    365             END SELECT   ! cd_type 
    366    
    367          CASE ( 5 , 6 )                 ! F pivot 
    368           iloc=jpiglo/2 
    369  
    370             SELECT CASE (cd_type ) 
    371  
    372             CASE ( 'T'  ,'S', 'U', 'W') 
    373                DO jk =1, 4 
    374                   DO ji = 1-jpr2di, nlci+jpr2di 
    375                      pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
    376                   ENDDO 
    377                ENDDO 
    378  
    379             CASE ( 'F' ,'G' , 'I', 'V' ) 
    380                DO jk =1, 4 
    381                   DO ji = 1-jpr2di, nlci+jpr2di 
    382                      pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
    383                   ENDDO 
    384                ENDDO 
    385                DO jk =1, 4 
    386                   DO ji = nlci+jpr2di, 1-jpr2di,  -1 
    387                     IF ( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) & 
    388                        & .OR. ( mi0(iloc) == jpi+1 ) ) EXIT 
     294               END DO 
     295            END DO 
     296            ! 
     297         CASE ( 'F' ,'G' , 'I', 'V' ) 
     298            DO jk =1, 4 
     299               DO ji = 1-jpr2di, nlci+jpr2di 
     300                  pt3d(ji,nlcj-1:nlcj+jpr2dj,jk) = ztab(ji,nlcj-1:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
     301               END DO 
     302            END DO 
     303            ! 
     304         END SELECT   ! cd_type 
     305          !  
     306      CASE ( 5 , 6 )                        !==  F pivot  ==! 
     307         iloc=jpiglo/2 
     308         ! 
     309         SELECT CASE (cd_type ) 
     310         ! 
     311         CASE ( 'T'  ,'S', 'U', 'W') 
     312            DO jk =1, 4 
     313               DO ji = 1-jpr2di, nlci+jpr2di 
     314                  pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
     315               END DO 
     316            END DO 
     317            ! 
     318         CASE ( 'F' ,'G' , 'I', 'V' ) 
     319            DO jk =1, 4 
     320               DO ji = 1-jpr2di, nlci+jpr2di 
     321                  pt3d(ji,nlcj:nlcj+jpr2dj,jk) = ztab(ji,nlcj:nlcj+jpr2dj,jk+3-2*MOD(jk+3,4))            
     322               END DO 
     323            END DO 
     324            DO jk =1, 4 
     325               DO ji = nlci+jpr2di, 1-jpr2di,  -1 
     326                  IF( ( ji .LT. mi0(iloc) .AND. mi0(iloc) /= 1 ) .OR. ( mi0(iloc) == jpi+1 ) )   EXIT 
    389327                    pt3d(ji,nlcj-1,jk) = ztab(ji,nlcj-1,jk+3-2*MOD(jk+3,4)) 
    390                   ENDDO 
    391                ENDDO 
    392  
    393             END SELECT   ! cd_type 
    394  
    395          END SELECT   ! npolj 
     328               END DO 
     329            END DO 
     330            ! 
     331         END SELECT   ! cd_type 
     332         ! 
     333      END SELECT   ! npolj 
    396334      !    
    397335   END SUBROUTINE sol_exd 

  • trunk/NEMO/OPA_SRC/SOL/solpcg.F90

    r1528 r1601  
    88   !!   sol_pcg    : preconditionned conjugate gradient solver 
    99   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1110   USE oce             ! ocean dynamics and tracers variables 
    1211   USE dom_oce         ! ocean space and time domain variables  
    … …  
    1918   PRIVATE 
    2019 
    21    !! * Routine accessibility 
    22    PUBLIC sol_pcg              ! ??? 
     20   PUBLIC   sol_pcg    !  
    2321 
    2422   !! * Substitutions 
    2523#  include "vectopt_loop_substitute.h90" 
    2624   !!---------------------------------------------------------------------- 
    27    !!---------------------------------------------------------------------- 
    28    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     25   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    2926   !! $Id$  
    30    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     27   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    3128   !!---------------------------------------------------------------------- 
    3229CONTAINS 
    … …  
    8582      !!        !  08-01  (R. Benshila) mpp optimization 
    8683      !!---------------------------------------------------------------------- 
    87       !! * Arguments 
    8884      INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver- 
    8985      !                                      ! gence is not reached: the model is 
    9086      !                                      ! stopped in step 
    9187      !                                      ! set to zero before the call of solpcg 
    92  
    93       !! * Local declarations 
     88      !! 
    9489      INTEGER ::   ji, jj, jn                ! dummy loop indices 
    9590      REAL(wp) ::  zgcad                     ! temporary scalars 
    … …  
    151146         
    152147      !                                                !================ 
    153       DO jn = 1, nmax                                  ! Iterative loop 
     148      DO jn = 1, nn_nmax                               ! Iterative loop 
    154149         !                                             !================ 
    155150 
    … …  
    177172 
    178173         ! test of convergence 
    179          IF( rnorme < epsr .OR. jn == nmax ) THEN 
     174         IF( rnorme < epsr .OR. jn == nn_nmax ) THEN 
    180175            res = SQRT( rnorme ) 
    181176            niter = jn 
    … …  
    200195         
    201196         ! indicator of non-convergence or explosion 
    202          IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 
     197         IF( jn == nn_nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 
    203198         IF( ncut == 999 ) GOTO 999 
    204199 

  • trunk/NEMO/OPA_SRC/SOL/solsor.F90

    r1528 r1601  
    44   !! Ocean solver :  Successive Over-Relaxation solver 
    55   !!===================================================================== 
     6   !! History :  OPA  ! 1990-10  (G. Madec)  Original code 
     7   !!            7.1  ! 1993-04  (G. Madec)  time filter 
     8   !!                 ! 1996-05  (G. Madec)  merge sor and pcg formulations 
     9   !!                 ! 1996-11  (A. Weaver)  correction to preconditioning 
     10   !!   NEMO     1.0  ! 2003-04  (C. Deltel, G. Madec)  Red-Black SOR in free form 
     11   !!            2.0  ! 2005-09  (R. Benshila, G. Madec)  MPI optimization 
     12   !!---------------------------------------------------------------------- 
    613 
    714   !!---------------------------------------------------------------------- 
    815   !!   sol_sor     : Red-Black Successive Over-Relaxation solver 
    916   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1117   USE oce             ! ocean dynamics and tracers variables 
    1218   USE dom_oce         ! ocean space and time domain variables  
    … …  
    2026   PRIVATE 
    2127 
    22    !! * Routine accessibility 
    23    PUBLIC sol_sor              ! ??? 
     28   PUBLIC   sol_sor    !  
    2429 
    2530   !!---------------------------------------------------------------------- 
    26    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     31   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    2732   !! $Id$  
    28    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     33   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    2934   !!---------------------------------------------------------------------- 
    3035 
    … …  
    4954      !!      conditions only when the inside domain is reached. 
    5055      !!  
    51       !! References : 
    52       !!      Madec et al. 1988, Ocean Modelling, issue 78, 1-6. 
    53       !!      Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 
     56      !! References :   Madec et al. 1988, Ocean Modelling, issue 78, 1-6. 
     57      !!                Beare and Stevens 1997 Ann. Geophysicae 15, 1369-1377 
     58      !!---------------------------------------------------------------------- 
     59      INTEGER, INTENT(inout) ::   kindic   ! solver indicator, < 0 if the convergence is not reached: 
     60      !                                    ! the model is stopped in step (set to zero before the call of solsor) 
    5461      !! 
    55       !! History : 
    56       !!        !  90-10  (G. Madec)  Original code 
    57       !!        !  91-11  (G. Madec) 
    58       !!   7.1  !  93-04  (G. Madec)  time filter 
    59       !!        !  96-05  (G. Madec)  merge sor and pcg formulations 
    60       !!        !  96-11  (A. Weaver)  correction to preconditioning 
    61       !!   9.0  !  03-04  (C. Deltel, G. Madec)  Red-Black SOR in free form 
    62       !!   9.0  !  05-09  (R. Benshila, G. Madec)  MPI optimization 
    63       !!---------------------------------------------------------------------- 
    64       !! * Arguments 
    65       INTEGER, INTENT( inout ) ::   kindic   ! solver indicator, < 0 if the conver- 
    66       !                                      ! gence is not reached: the model is 
    67       !                                      ! stopped in step 
    68       !                                      ! set to zero before the call of solsor 
    69       !! * Local declarations 
    7062      INTEGER  ::   ji, jj, jn               ! dummy loop indices 
    7163      INTEGER  ::   ishift, icount 
     64      INTEGER  ::   ijmppodd, ijmppeven, ijpr2d 
    7265      REAL(wp) ::   ztmp, zres, zres2 
    73  
    74       INTEGER  ::   ijmppodd, ijmppeven 
    75       INTEGER  ::   ijpr2d 
    7666      !!---------------------------------------------------------------------- 
    7767       
    78       ijmppeven = MOD(nimpp+njmpp+jpr2di+jpr2dj,2) 
    79       ijmppodd  = MOD(nimpp+njmpp+jpr2di+jpr2dj+1,2) 
    80       ijpr2d = MAX(jpr2di,jpr2dj) 
     68      ijmppeven = MOD( nimpp+njmpp+jpr2di+jpr2dj   , 2 ) 
     69      ijmppodd  = MOD( nimpp+njmpp+jpr2di+jpr2dj+1 , 2 ) 
     70      ijpr2d    = MAX( jpr2di , jpr2dj ) 
    8171      icount = 0 
    8272      !                                                       ! ============== 
    83       DO jn = 1, nmax                                         ! Iterative loop  
     73      DO jn = 1, nn_nmax                                      ! Iterative loop  
    8474         !                                                    ! ============== 
    8575 
    86          ! applied the lateral boundary conditions 
    87          IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    
     76         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions 
    8877         
    8978         ! Residus 
    … …  
    10392               gcr(ji,jj) = zres * gcdmat(ji,jj) * zres 
    10493               ! Guess update 
    105                gcx(ji,jj) = sor * ztmp + (1-sor) * gcx(ji,jj) 
     94               gcx(ji,jj) = rn_sor * ztmp + (1-rn_sor) * gcx(ji,jj) 
    10695            END DO 
    10796         END DO 
    10897         icount = icount + 1  
    10998  
    110          ! applied the lateral boundary conditions 
    111          IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   
     99         IF( MOD(icount,ijpr2d+1) == 0 )   CALL lbc_lnk_e( gcx, c_solver_pt, 1. )   ! lateral boundary conditions 
    112100 
    113101         ! Guess red update 
    … …  
    124112               gcr(ji,jj) = zres * gcdmat(ji,jj) * zres 
    125113               ! Guess update 
    126                gcx(ji,jj) = sor * ztmp + (1-sor) * gcx(ji,jj) 
     114               gcx(ji,jj) = rn_sor * ztmp + (1-rn_sor) * gcx(ji,jj) 
    127115            END DO 
    128116         END DO 
    … …  
    130118 
    131119         ! test of convergence 
    132          IF ( jn > nmin .AND. MOD( jn-nmin, nmod ) == 0 ) then 
     120         IF ( jn > nn_nmin .AND. MOD( jn-nn_nmin, nn_nmod ) == 0 ) THEN 
    133121 
    134             SELECT CASE ( nsol_arp ) 
     122            SELECT CASE ( nn_sol_arp ) 
    135123            CASE ( 0 )                 ! absolute precision (maximum value of the residual) 
    136124               zres2 = MAXVAL( gcr(2:nlci-1,2:nlcj-1) ) 
    137125               IF( lk_mpp )   CALL mpp_max( zres2 )   ! max over the global domain 
    138126               ! test of convergence 
    139                IF( zres2 < resmax .OR. jn == nmax ) THEN 
     127               IF( zres2 < rn_resmax .OR. jn == nn_nmax ) THEN 
    140128                  res = SQRT( zres2 ) 
    141129                  niter = jn 
    … …  
    146134               IF( lk_mpp )   CALL mpp_sum( rnorme )   ! sum over the global domain 
    147135               ! test of convergence 
    148                IF( rnorme < epsr .OR. jn == nmax ) THEN 
     136               IF( rnorme < epsr .OR. jn == nn_nmax ) THEN 
    149137                  res = SQRT( rnorme ) 
    150138                  niter = jn 
    … …  
    160148         ENDIF 
    161149         ! indicator of non-convergence or explosion 
    162          IF( jn == nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 
     150         IF( jn == nn_nmax .OR. SQRT(epsr)/eps > 1.e+20 ) kindic = -2 
    163151         IF( ncut == 999 ) GOTO 999 
    164152          
    … …  
    169157999   CONTINUE 
    170158       
    171        
    172159      !  Output in gcx 
    173160      !  ------------- 
    174  
    175161      CALL lbc_lnk_e( gcx, c_solver_pt, 1. )    ! boundary conditions 
    176  
    177        
     162      ! 
    178163   END SUBROUTINE sol_sor 
    179164 

  • trunk/NEMO/OPA_SRC/SOL/solver.F90

    r1581 r1601  
    44   !! Ocean solver :  initialization of ocean solver 
    55   !!===================================================================== 
    6  
     6   !! History :  OPA  ! 1990-10  (G. Madec)  Original code            
     7   !!                 ! 1993-02  (O. Marti)                          
     8   !!                 ! 1997-02  (G. Madec)  local depth inverse computation 
     9   !!                 ! 1998-10  (G. Roullet, G. Madec)  free surface  
     10   !!   NEMO     1.0  ! 2003-07  (G. Madec)  free form, F90 
     11   !!            3.2  ! 2009-07  (R. Benshila) suppression of rigid-lid & FETI solver 
     12   !!---------------------------------------------------------------------- 
     13#if defined key_dynspg_flt   ||   defined key_esopa   
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_dynspg_flt'                              filtered free surface 
    716   !!---------------------------------------------------------------------- 
    817   !!   solver_init: solver initialization 
    918   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1119   USE oce             ! ocean dynamics and tracers variables 
    1220   USE dom_oce         ! ocean space and time domain variables  
    1321   USE zdf_oce         ! ocean vertical physics variables 
    1422   USE sol_oce         ! solver variables 
    15    USE solmat          ! ??? 
     23   USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
     24   USE solmat          ! matrix of the solver 
    1625   USE obc_oce         ! Lateral open boundary condition 
    1726   USE in_out_manager  ! I/O manager 
    1827   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    1928   USE lib_mpp 
    20    USE dynspg_oce      ! choice/control of key cpp for surface pressure gradient 
    2129 
    2230   IMPLICIT NONE 
    2331 
    2432   !!---------------------------------------------------------------------- 
    25    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     33   !! NEMO/OPA 9.0 , LOCEAN-IPSL (2009)  
    2634   !! $Id$  
    27    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     35   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    2836   !!---------------------------------------------------------------------- 
    2937 
    … …  
    3442      !!                  ***  ROUTINE solver_init  *** 
    3543      !!                    
    36       !! ** Purpose :   Initialization for the solver of the elliptic equation: 
    37       !!       * lk_dynspg_flt = T : transport divergence system.  
     44      !! ** Purpose :   Initialization of the elliptic solver 
    3845      !!       
    39       !! ** Method : 
    40       !!       - Compute the local depth of the water column at u- and v-point 
    41       !!      The local depth of the water column is computed by summing  
    42       !!      the vertical scale factors. For its inverse, the thickness of 
    43       !!      the first model level is imposed as lower bound. The inverse of 
    44       !!      this depth is THEN taken and masked, so that the inverse of the 
    45       !!      local depth is zero when the local depth is zero. 
     46      !! ** Method  :   a solver is required when using the filtered free 
     47      !!              surface.  
    4648      !! 
    47       !! ** Action : - hur, hvr : masked inverse of the local depth at 
    48       !!                                u- and v-point. 
    49       !!             - hu, hv   : masked local depth at u- and v- points 
    50       !!             - c_solver_pt : nature of the gridpoint at which the 
    51       !!                                solver is applied 
    52       !! References : 
    53       !!      Jensen, 1986: adv. phys. oceanogr. num. mod.,ed. o brien,87-110. 
    54       !!      Madec & Marti, 1990: internal rep. LODYC, 90/03., 29pp. 
     49      !! ** Action  : - c_solver_pt : nature of the gridpoint at which the solver is applied 
    5550      !! 
    56       !! History : 
    57       !!        !  90-10  (G. Madec)  Original code            
    58       !!        !  93-02  (O. Marti)                          
    59       !!        !  97-02  (G. Madec)  local depth inverse computation 
    60       !!        !  98-10  (G. Roullet, G. Madec)  free surface  
    61       !!   9.0  !  03-07  (G. Madec)  free form, F90 
    62       !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization 
     51      !! References : Jensen, 1986: Adv. Phys. Oceanogr. Num. Mod.,Ed. O Brien,87-110. 
    6352      !!---------------------------------------------------------------------- 
    64       !! * Arguments 
    6553      INTEGER, INTENT(in) :: kt 
    66  
    67       NAMELIST/namsol/ nsolv, nsol_arp, nmin, nmax, nmod, eps, resmax, sor, rnu 
     54      !! 
     55      NAMELIST/namsol/ nn_solv, nn_sol_arp, nn_nmin, nn_nmax, nn_nmod, rn_eps, rn_resmax, rn_sor 
    6856      !!---------------------------------------------------------------------- 
    6957 
    70       IF(lwp) THEN 
     58      IF(lwp) THEN                  !* open elliptic solver statistics file (only on the printing processors) 
     59         CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     60      ENDIF 
     61 
     62      REWIND( numnam )              !* Namelist namsol : elliptic solver / free surface 
     63      READ  ( numnam, namsol ) 
     64 
     65      IF(lwp) THEN                  !* Control print 
    7166         WRITE(numout,*) 
    7267         WRITE(numout,*) 'solver_init : solver to compute the surface pressure gradient' 
    7368         WRITE(numout,*) '~~~~~~~~~~~' 
    74           
    75          ! open elliptic solver statistics file 
    76          CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    77       ENDIF 
    78  
    79  
    80       ! 0. Define the solver parameters 
    81       !    ---------------------------- 
    82       ! Namelist namsol : elliptic solver / free surface 
    83       REWIND( numnam ) 
    84       READ  ( numnam, namsol ) 
    85  
    86       ! 0. Parameter control and print 
    87       !    --------------------------- 
    88  
    89       ! Control print 
    90       IF(lwp) WRITE(numout,*) '          Namelist namsol : set solver parameters' 
    91  
    92       IF(lwp) THEN 
    93          WRITE(numout,*) '             type of elliptic solver            nsolv    = ', nsolv 
    94          WRITE(numout,*) '             absolute/relative (0/1) precision  nsol_arp = ', nsol_arp 
    95          WRITE(numout,*) '             minimum iterations for solver      nmin     = ', nmin 
    96          WRITE(numout,*) '             maximum iterations for solver      nmax     = ', nmax 
    97          WRITE(numout,*) '             frequency for test                 nmod     = ', nmod 
    98          WRITE(numout,*) '             absolute precision of solver       eps      = ', eps 
    99          WRITE(numout,*) '             absolute precision for SOR solver  resmax   = ', resmax 
    100          WRITE(numout,*) '             optimal coefficient of sor         sor      = ', sor 
    101          WRITE(numout,*) '             free surface parameter         rnu    = ', rnu 
     69         WRITE(numout,*) '   Namelist namsol : set solver parameters' 
     70         WRITE(numout,*) '      type of elliptic solver            nn_solv    = ', nn_solv 
     71         WRITE(numout,*) '      absolute/relative (0/1) precision  nn_sol_arp = ', nn_sol_arp 
     72         WRITE(numout,*) '      minimum iterations for solver      nn_nmin    = ', nn_nmin 
     73         WRITE(numout,*) '      maximum iterations for solver      nn_nmax    = ', nn_nmax 
     74         WRITE(numout,*) '      frequency for test                 nn_nmod    = ', nn_nmod 
     75         WRITE(numout,*) '      absolute precision of solver       rn_eps     = ', rn_eps 
     76         WRITE(numout,*) '      absolute precision for SOR solver  rn_resmax  = ', rn_resmax 
     77         WRITE(numout,*) '      optimal coefficient of sor         rn_sor     = ', rn_sor 
    10278         WRITE(numout,*) 
    10379      ENDIF 
     80      eps = rn_eps 
    10481 
    105       IF( lk_dynspg_flt ) THEN 
    106          IF(lwp) WRITE(numout,*) 
    107          IF(lwp) WRITE(numout,*) '          free surface formulation' 
    108       ELSE 
    109          CALL ctl_stop( '          Choose only one surface pressure gradient calculation: filtered ',   & 
    110               &         '          Should not call this routine if dynspg_exp or dynspg_ts has been chosen' ) 
    111       ENDIF 
    112  
    113       SELECT CASE ( nsolv ) 
    114  
    115       CASE ( 1 )                ! preconditioned conjugate gradient solver 
    116          IF(lwp) WRITE(numout,*) '          a preconditioned conjugate gradient solver is used' 
    117          IF( jpr2di /= 0 .AND. jpr2dj /= 0 ) & 
    118             CALL ctl_stop( ' jpr2di and jpr2dj should be equal to zero' ) 
    119  
    120       CASE ( 2 )                ! successive-over-relaxation solver 
    121          IF(lwp) WRITE(numout,*) '          a successive-over-relaxation solver with extra outer halo is used' 
    122          IF(lwp) WRITE(numout,*) '          with jpr2di =', jpr2di, ' and  jpr2dj =', jpr2dj 
     82      SELECT CASE( nn_solv )          !* parameter check 
     83      ! 
     84      CASE ( 1 )                          ! preconditioned conjugate gradient solver 
     85         IF(lwp) WRITE(numout,*) '   a preconditioned conjugate gradient solver is used' 
     86         IF( jpr2di /= 0 .AND. jpr2dj /= 0 )   CALL ctl_stop( ' jpr2di and jpr2dj should be equal to zero' ) 
     87         ! 
     88      CASE ( 2 )                          ! successive-over-relaxation solver 
     89         IF(lwp) WRITE(numout,*) '   a successive-over-relaxation solver with extra outer halo is used' 
     90         IF(lwp) WRITE(numout,*) '   with jpr2di =', jpr2di, ' and  jpr2dj =', jpr2dj 
    12391         IF( .NOT. lk_mpp .AND. jpr2di /= 0 .AND. jpr2dj /= 0 ) THEN 
    124              CALL ctl_stop( ' jpr2di and jpr2dj are not equal to zero',   & 
    125              &              ' In this case this algorithm should be used only with the key_mpp_... option' ) 
     92             CALL ctl_stop( 'jpr2di and jpr2dj are not equal to zero',   & 
     93             &              'In this case the algorithm should be used only with the key_mpp_... option' ) 
    12694         ELSE 
    12795            IF( ( ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 ) .OR. ( jpni /= 1 ) ) & 
    128               &  .AND. ( jpr2di /= jpr2dj ) ) CALL ctl_stop( '          jpr2di should be equal to jpr2dj' ) 
     96              &  .AND. ( jpr2di /= jpr2dj ) )   CALL ctl_stop( 'jpr2di should be equal to jpr2dj' ) 
    12997         ENDIF 
    130  
    131       CASE DEFAULT 
    132          WRITE(ctmp1,*) '          bad flag value for nsolv = ', nsolv 
     98         ! 
     99      CASE DEFAULT                        ! error in parameter 
     100         WRITE(ctmp1,*) '          bad flag value for nn_solv = ', nn_solv 
    133101         CALL ctl_stop( ctmp1 ) 
    134           
    135102      END SELECT 
    136  
    137       IF( nbit_cmp == 1 ) THEN 
    138          IF( nsolv /= 2 ) THEN 
    139             CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require the SOR solver: nsolv = 2' ) 
     103      ! 
     104      IF( nbit_cmp == 1 ) THEN            ! reproductibility test SOR required 
     105         IF( nn_solv /= 2 ) THEN 
     106            CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require the SOR solver: nn_solv = 2' ) 
    140107         ELSE IF( MAX( jpr2di, jpr2dj ) > 0 ) THEN 
    141108            CALL ctl_stop( ' Reproductibility tests (nbit_cmp=1) require jpr2di = jpr2dj = 0' ) 
    … …  
    143110      END IF 
    144111 
    145       ! Grid-point at which the solver is applied 
    146       ! ----------------------------------------- 
    147  
    148       IF( lk_mpp ) THEN 
    149          c_solver_pt = 'S'   ! S=T with special staff ??? which one? 
    150       ELSE 
    151          c_solver_pt = 'T' 
     112      !                             !* Grid-point at which the solver is applied 
     113!!gm  c_solver_pt should be removed: nomore bsf, only T-point is used 
     114      IF( lk_mpp ) THEN   ;    c_solver_pt = 'S'   ! S=T with special staff ??? which one? 
     115      ELSE                ;    c_solver_pt = 'T' 
    152116      ENDIF 
    153117 
    154       ! Construction of the elliptic system matrix 
    155       ! ------------------------------------------ 
    156  
    157       CALL sol_mat( kt ) 
     118      CALL sol_mat( kt )            !* Construction of the elliptic system matrix 
    158119      ! 
    159120   END SUBROUTINE solver_init 
     121#endif 
    160122 
    161123   !!====================================================================== 

  • trunk/NEMO/OPA_SRC/TRA/traadv.F90

    r1482 r1601  
    3131   PUBLIC   tra_adv    ! routine called by step module 
    3232  
    33    !!* Namelist nam_traadv 
     33   !                                                   !!* Namelist namtra_adv * 
    3434   LOGICAL, PUBLIC ::   ln_traadv_cen2   = .TRUE.       ! 2nd order centered scheme flag 
    3535   LOGICAL, PUBLIC ::   ln_traadv_tvd    = .FALSE.      ! TVD scheme flag 
    … …  
    136136      INTEGER ::   ioptio 
    137137 
    138       NAMELIST/nam_traadv/ ln_traadv_cen2 , ln_traadv_tvd,    & 
     138      NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd,    & 
    139139         &                 ln_traadv_muscl, ln_traadv_muscl2, & 
    140140         &                 ln_traadv_ubs  , ln_traadv_qck 
    141141      !!---------------------------------------------------------------------- 
    142142 
    143       REWIND ( numnam )               ! Read Namelist nam_traadv : tracer advection scheme 
    144       READ   ( numnam, nam_traadv ) 
     143      REWIND ( numnam )               ! Read Namelist namtra_adv : tracer advection scheme 
     144      READ   ( numnam, namtra_adv ) 
    145145 
    146146      IF(lwp) THEN                    ! Namelist print 
    … …  
    148148         WRITE(numout,*) 'tra_adv_ctl : choice/control of the tracer advection scheme' 
    149149         WRITE(numout,*) '~~~~~~~~~~~' 
    150          WRITE(numout,*) '       Namelist nam_traadv : chose a advection scheme for tracers' 
    151          WRITE(numout,*) '          2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2 
    152          WRITE(numout,*) '          TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd 
    153          WRITE(numout,*) '          MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl 
    154          WRITE(numout,*) '          MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2 
    155          WRITE(numout,*) '          UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs 
    156          WRITE(numout,*) '          QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck 
     150         WRITE(numout,*) '   Namelist namtra_adv : chose a advection scheme for tracers' 
     151         WRITE(numout,*) '      2nd order advection scheme     ln_traadv_cen2   = ', ln_traadv_cen2 
     152         WRITE(numout,*) '      TVD advection scheme           ln_traadv_tvd    = ', ln_traadv_tvd 
     153         WRITE(numout,*) '      MUSCL  advection scheme        ln_traadv_muscl  = ', ln_traadv_muscl 
     154         WRITE(numout,*) '      MUSCL2 advection scheme        ln_traadv_muscl2 = ', ln_traadv_muscl2 
     155         WRITE(numout,*) '      UBS    advection scheme        ln_traadv_ubs    = ', ln_traadv_ubs 
     156         WRITE(numout,*) '      QUICKEST advection scheme      ln_traadv_qck    = ', ln_traadv_qck 
    157157    ENDIF 
    158158 
    … …  
    166166      IF( lk_esopa         )   ioptio =          1 
    167167 
    168       IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist nam_traadv' ) 
     168      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' ) 
    169169 
    170170      IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 )   & 

  • trunk/NEMO/OPA_SRC/TRA/trabbc.F90

    r1152 r1601  
    1515   !!   tra_bbc_init : initialization of geothermal heat flux trend 
    1616   !!---------------------------------------------------------------------- 
    17    !! * Modules used 
    1817   USE oce             ! ocean dynamics and active tracers 
    1918   USE dom_oce         ! ocean space and time domain 
    … …  
    3231   LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   !: bbc flag 
    3332 
    34    !!* Namelist nambbc: bottom boundary condition 
    35    INTEGER  ::   ngeo_flux       = 1            ! Geothermal flux (0:no flux, 1:constant flux, 2:read in file ) 
    36    REAL(wp) ::   ngeo_flux_const = 86.4e-3      ! Constant value of geothermal heat flux 
     33   !                                         !!* Namelist nambbc: bottom boundary condition * 
     34   INTEGER  ::   nn_geoflx     = 1            ! Geothermal flux (0:no flux, 1:constant flux, 2:read in file ) 
     35   REAL(wp) ::   rn_geoflx_cst = 86.4e-3      ! Constant value of geothermal heat flux 
    3736 
    3837   INTEGER , DIMENSION(jpi,jpj) ::   nbotlevt   ! ocean bottom level index at T-pt 
    … …  
    4241#  include "domzgr_substitute.h90" 
    4342   !!---------------------------------------------------------------------- 
    44    !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     43   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    4544   !! $Id$  
    4645   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    5453      !! 
    5554      !! ** Purpose :   Compute the bottom boundary contition on temperature  
    56       !!      associated with geothermal heating and add it to the general 
    57       !!      trend of temperature equations. 
     55      !!              associated with geothermal heating and add it to the  
     56      !!              general trend of temperature equations. 
    5857      !! 
    5958      !! ** Method  :   The geothermal heat flux set to its constant value of  
    60       !!       86.4 mW/m2 (Stein and Stein 1992, Huang 1999). 
     59      !!              86.4 mW/m2 (Stein and Stein 1992, Huang 1999). 
    6160      !!       The temperature trend associated to this heat flux through the 
    6261      !!       ocean bottom can be computed once and is added to the temperature 
    … …  
    6968      !! 
    7069      !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. 
     70      !!              Emile-Geay and Madec, 2009, Ocean Science. 
    7171      !!---------------------------------------------------------------------- 
    7272      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
    … …  
    7575      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    7676      !! 
    77 #if defined key_vectopt_loop 
    78       INTEGER ::   ji       ! dummy loop indices 
    79 #else 
    80       INTEGER ::   ji, jj   ! dummy loop indices 
    81 #endif 
     77      INTEGER  ::   ji, jj    ! dummy loop indices 
    8278      REAL(wp) ::   zqgh_trd  ! geothermal heat flux trend 
    8379      !!---------------------------------------------------------------------- 
    … …  
    9288      ! Add the geothermal heat flux trend on temperature 
    9389 
    94       SELECT CASE ( ngeo_flux ) 
     90      SELECT CASE ( nn_geoflx ) 
    9591      ! 
    9692      CASE ( 1:2 )                !  geothermal heat flux 
    9793#if defined key_vectopt_loop 
    98          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    99             zqgh_trd = ro0cpr * qgh_trd0(ji,1) / fse3t(ji,1,nbotlevt(ji,1) ) 
    100             ta(ji,1,nbotlevt(ji,1)) = ta(ji,1,nbotlevt(ji,1)) + zqgh_trd 
    101          END DO 
     94         DO jj = 1, 1 
     95            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    10296#else 
    10397         DO jj = 2, jpjm1 
    10498            DO ji = 2, jpim1 
     99#endif 
    105100               zqgh_trd = ro0cpr * qgh_trd0(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj)) 
    106101               ta(ji,jj,nbotlevt(ji,jj)) = ta(ji,jj,nbotlevt(ji,jj)) + zqgh_trd 
    107102            END DO 
    108103         END DO 
    109 #endif 
    110104      END SELECT 
    111105 
    … …  
    115109      ENDIF 
    116110      ! 
    117       IF(ln_ctl)   CALL prt_ctl(tab3d_1=ta, clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta') 
     111      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' bbc  - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 
    118112      ! 
    119113   END SUBROUTINE tra_bbc 
    … …  
    124118      !!                  ***  ROUTINE tra_bbc_init  *** 
    125119      !! 
    126       !! ** Purpose :   Compute once for all the trend associated with geo- 
    127       !!      thermal heating that will be applied at each time step at the 
    128       !!      bottom ocean level 
     120      !! ** Purpose :   Compute once for all the trend associated with geothermal 
     121      !!              heating that will be applied at each time step at the 
     122      !!              last ocean level 
    129123      !! 
    130124      !! ** Method  :   Read the nambbc namelist and check the parameters. 
    131       !!      called at the first time step (nit000) 
    132125      !! 
    133126      !! ** Input   : - Namlist nambbc 
    … …  
    141134      INTEGER  ::   ji, jj              ! dummy loop indices 
    142135      INTEGER  ::   inum                ! temporary logical unit 
    143  
    144       NAMELIST/nambbc/ngeo_flux, ngeo_flux_const  
     136      !! 
     137      NAMELIST/nambbc/nn_geoflx, rn_geoflx_cst  
    145138      !!---------------------------------------------------------------------- 
    146139 
    … …  
    148141      READ   ( numnam, nambbc ) 
    149142 
    150       !                              ! Control print 
    151       IF(lwp) WRITE(numout,*) 
    152       IF(lwp) WRITE(numout,*) 'tra_bbc : tempearture Bottom Boundary Condition (bbc)' 
    153       IF(lwp) WRITE(numout,*) '~~~~~~~   Geothermal heatflux' 
    154       IF(lwp) WRITE(numout,*) '          Namelist nambbc : set bbc parameters' 
    155       IF(lwp) WRITE(numout,*) 
    156       IF(lwp) WRITE(numout,*) '             Geothermal flux           ngeo_flux       = ', ngeo_flux 
    157       IF(lwp) WRITE(numout,*) '             Constant geothermal flux  ngeo_flux_const = ', ngeo_flux_const 
    158       IF(lwp) WRITE(numout,*) 
     143      IF(lwp) THEN                   ! Control print 
     144        WRITE(numout,*) 
     145         WRITE(numout,*) 'tra_bbc : temperature Bottom Boundary Condition (bbc), Geothermal heatflux' 
     146         WRITE(numout,*) '~~~~~~~   ' 
     147         WRITE(numout,*) '   Namelist nambbc : set bbc parameters' 
     148         WRITE(numout,*) '      Geothermal flux            nn_geoflx     = ', nn_geoflx 
     149         WRITE(numout,*) '      Constant geothermal flux   rn_geoflx_cst = ', rn_geoflx_cst 
     150         WRITE(numout,*) 
     151      ENDIF 
    159152 
    160153      !                              ! level of the ocean bottom at T-point 
    … …  
    165158      END DO 
    166159 
    167       SELECT CASE ( ngeo_flux )      ! initialization of geothermal heat flux 
     160      SELECT CASE ( nn_geoflx )      ! initialization of geothermal heat flux 
    168161      ! 
    169162      CASE ( 0 )                ! no geothermal heat flux 
    170          IF(lwp) WRITE(numout,*) 
    171          IF(lwp) WRITE(numout,*) '             *** no geothermal heat flux' 
     163         IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux' 
    172164         ! 
    173165      CASE ( 1 )                ! constant flux 
    174          IF(lwp) WRITE(numout,*) '             *** constant heat flux  =   ', ngeo_flux_const 
    175          qgh_trd0(:,:) = ngeo_flux_const 
     166         IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst 
    176167         ! 
    177       CASE ( 2 )                ! variable geothermal heat flux 
    178          ! read the geothermal fluxes in mW/m2 
     168         qgh_trd0(:,:) = rn_geoflx_cst 
    179169         ! 
    180          IF(lwp) WRITE(numout,*) '             *** variable geothermal heat flux' 
     170      CASE ( 2 )                ! variable geothermal heat flux : read the geothermal fluxes in mW/m2 
     171         IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux' 
    181172         CALL iom_open ( 'geothermal_heating.nc', inum ) 
    182          CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 
    183          CALL iom_close (inum) 
     173         CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 
     174         CALL iom_close( inum ) 
    184175         ! 
    185176         qgh_trd0(:,:) = qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2 
    186177         ! 
    187178      CASE DEFAULT 
    188          WRITE(ctmp1,*) '     bad flag value for ngeo_flux = ', ngeo_flux 
     179         WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx 
    189180         CALL ctl_stop( ctmp1 ) 
    190181         ! 
    191182      END SELECT 
    192  
    193  
     183      ! 
    194184   END SUBROUTINE tra_bbc_init 
    195185 

  • trunk/NEMO/OPA_SRC/TRA/trabbl.F90

    r1152 r1601  
    3535 
    3636   !!* Namelist nambbl: bottom boundary layer 
    37    REAL(wp), PUBLIC ::   atrbbl = 1.e+3   !: lateral coeff. for bottom boundary layer scheme (m2/s) 
     37   REAL(wp), PUBLIC ::   rn_ahtbbl = 1.e+3   !: lateral coeff. for bottom boundary layer scheme (m2/s) 
    3838 
    3939# if defined key_trabbl_dif 
    … …  
    108108      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    109109      !! 
    110       INTEGER  ::   ji, jj                   ! dummy loop indices 
     110      INTEGER  ::   ji, jj                  ! dummy loop indices 
    111111      INTEGER  ::   ik 
    112       INTEGER  ::   ii0, ii1, ij0, ij1       ! temporary integers 
     112      INTEGER  ::   ii0, ii1, ij0, ij1      ! temporary integers 
    113113      INTEGER  ::   iku1, iku2, ikv1,ikv2   ! temporary intergers 
    114114      REAL(wp) ::   ze3u, ze3v              ! temporary scalars 
    115115      INTEGER  ::   iku, ikv 
    116       REAL(wp) ::   & 
    117          zsign, zt, zs, zh, zalbet,      &  ! temporary scalars 
    118          zgdrho, zbtr, zta, zsa 
    119       REAL(wp), DIMENSION(jpi,jpj) ::    & 
    120         zki, zkj, zkw, zkx, zky, zkz,    &  ! 2D workspace arrays 
    121         ztnb, zsnb, zdep,                & 
    122         ztbb, zsbb, zahu, zahv 
     116      REAL(wp) ::   zsign, zt, zs, zh, zalbet   ! temporary scalars 
     117      REAL(wp) ::   zgdrho, zbtr, zta, zsa 
     118      REAL(wp), DIMENSION(jpi,jpj) ::   zki, zkj, zkw, zkx, zky, zkz             ! 2D workspace 
     119      REAL(wp), DIMENSION(jpi,jpj) ::   ztnb, zsnb, zdep, ztbb, zsbb, zahu, zahv 
     120      !! 
    123121      REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function 
    124122      !!---------------------------------------------------------------------- 
    … …  
    132130      fsalbt( pft, pfs, pfh ) =                                              & 
    133131         ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    & 
    134                                    - 0.203814e-03 ) * pft                    & 
    135                                    + 0.170907e-01 ) * pft                    & 
    136                                    + 0.665157e-01                            & 
     132         &                         - 0.203814e-03 ) * pft                    & 
     133         &                         + 0.170907e-01 ) * pft                    & 
     134         &                         + 0.665157e-01                            & 
    137135         +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   & 
    138136         +  ( ( - 0.302285e-13 * pfh                                         & 
    139                 - 0.251520e-11 * pfs                                         & 
    140                 + 0.512857e-12 * pft * pft          ) * pfh                  & 
    141                                      - 0.164759e-06   * pfs                  & 
    142              +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  & 
    143                                      + 0.380374e-04 ) * pfh    
     137         &      - 0.251520e-11 * pfs                                         & 
     138         &      + 0.512857e-12 * pft * pft          ) * pfh                  & 
     139         &                           - 0.164759e-06   * pfs                  & 
     140         &   +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  & 
     141         &                           + 0.380374e-04 ) * pfh    
    144142      !!---------------------------------------------------------------------- 
    145143 
    … …  
    155153      ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 
    156154#  if defined key_vectopt_loop 
    157       jj = 1 
    158       DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     155      DO jj = 1, 1 
     156         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    159157#  else 
    160158      DO jj = 1, jpj 
    … …  
    167165            zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1) 
    168166            zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level 
    169 #  if ! defined key_vectopt_loop 
    170          END DO 
    171 #  endif 
     167         END DO 
    172168      END DO 
    173169 
    174170      IF( ln_zps ) THEN      ! partial steps correction  
    175171# if defined key_vectopt_loop 
    176          jj = 1 
    177          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     172         DO jj = 1, 1 
     173            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    178174# else 
    179175         DO jj = 1, jpjm1 
    … …  
    186182               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
    187183               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
    188                zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
    189                zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
    190 # if ! defined key_vectopt_loop 
     184               zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 
     185               zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 
    191186            END DO 
    192 # endif 
    193187         END DO 
    194188      ELSE                    ! z-coordinate - full steps or s-coordinate 
    195189#   if defined key_vectopt_loop 
    196          jj = 1 
    197          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     190         DO jj = 1, 1 
     191            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    198192#   else 
    199193         DO jj = 1, jpjm1 
    … …  
    202196               iku = mbku(ji,jj) 
    203197               ikv = mbkv(ji,jj) 
    204                zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
    205                zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
    206 #   if ! defined key_vectopt_loop 
     198               zahu(ji,jj) = rn_ahtbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 
     199               zahv(ji,jj) = rn_ahtbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 
    207200            END DO 
    208 #   endif 
    209201         END DO 
    210202      ENDIF 
    … …  
    215207      ! multiplied by the slope of the ocean bottom 
    216208 
    217       SELECT CASE ( neos ) 
    218  
    219       CASE ( 0 )                 ! Jackett and McDougall (1994) formulation 
    220  
    221 #  if defined key_vectopt_loop 
    222       jj = 1 
    223       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    224 #  else 
    225       DO jj = 1, jpjm1 
    226          DO ji = 1, jpim1 
    227 #  endif 
    228             ! temperature, salinity anomalie and depth 
    229             zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
    230             zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
    231             zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    232             ! masked ratio alpha/beta 
    233             zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1) 
    234             ! local density gradient along i-bathymetric slope 
    235             zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
    236                    -          ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
    237             ! sign of local i-gradient of density multiplied by the i-slope 
    238             zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    239             zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    240 #  if ! defined key_vectopt_loop 
    241          END DO 
    242 #  endif 
    243       END DO 
    244  
    245 #  if defined key_vectopt_loop 
    246       jj = 1 
    247       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    248 #  else 
    249       DO jj = 1, jpjm1 
    250          DO ji = 1, jpim1 
    251 #  endif 
    252             ! temperature, salinity anomalie and depth 
    253             zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
    254             zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
    255             zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    256             ! masked ratio alpha/beta 
    257             zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1) 
    258             ! local density gradient along j-bathymetric slope 
    259             zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    260                    -          ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    261             ! sign of local j-gradient of density multiplied by the j-slope 
    262             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    263             zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    264 #  if ! defined key_vectopt_loop 
    265          END DO 
    266 #  endif 
    267       END DO 
    268  
    269       CASE ( 1 )               ! Linear formulation function of temperature only 
    270                                !  
    271 #  if defined key_vectopt_loop 
    272       jj = 1 
    273       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    274 #  else 
    275       DO jj = 1, jpjm1 
    276          DO ji = 1, jpim1 
    277 #  endif 
    278             ! local 'density/temperature' gradient along i-bathymetric slope 
    279             zgdrho =  ztnb(ji+1,jj) - ztnb(ji,jj)  
    280             ! sign of local i-gradient of density multiplied by the i-slope 
    281             zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    282             zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    283 #  if ! defined key_vectopt_loop 
    284          END DO 
    285 #  endif 
    286       END DO 
    287  
    288 #  if defined key_vectopt_loop 
    289       jj = 1 
    290       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    291 #  else 
    292       DO jj = 1, jpjm1 
    293          DO ji = 1, jpim1 
    294 #  endif 
    295             ! local density gradient along j-bathymetric slope 
    296             zgdrho =  ztnb(ji,jj+1) - ztnb(ji,jj)  
    297             ! sign of local j-gradient of density multiplied by the j-slope 
    298             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    299             zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    300 #  if ! defined key_vectopt_loop 
    301          END DO 
    302 #  endif 
    303       END DO 
    304  
    305       CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    306  
    307 #  if defined key_vectopt_loop 
    308       jj = 1 
    309       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    310 #  else 
    311       DO jj = 1, jpjm1 
    312          DO ji = 1, jpim1 
     209      SELECT CASE ( nn_eos ) 
     210      ! 
     211      CASE ( 0 )                 !==  Jackett and McDougall (1994) formulation  ==! 
     212#  if defined key_vectopt_loop 
     213         DO jj = 1, 1 
     214            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     215#  else 
     216         DO jj = 1, jpjm1 
     217            DO ji = 1, jpim1 
     218#  endif 
     219               ! temperature, salinity anomalie and depth 
     220               zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
     221               zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
     222               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
     223               ! masked ratio alpha/beta 
     224               zalbet = fsalbt( zt, zs, zh )*umask(ji,jj,1) 
     225               ! local density gradient along i-bathymetric slope 
     226               zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
     227                      -          ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
     228               ! sign of local i-gradient of density multiplied by the i-slope 
     229               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     230               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
     231               ! 
     232               ! temperature, salinity anomalie and depth 
     233               zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
     234               zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
     235               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
     236               ! masked ratio alpha/beta 
     237               zalbet = fsalbt( zt, zs, zh )*vmask(ji,jj,1) 
     238               ! local density gradient along j-bathymetric slope 
     239               zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
     240                      -          ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
     241               ! sign of local j-gradient of density multiplied by the j-slope 
     242               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     243               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
     244            END DO 
     245         END DO 
     246         ! 
     247      CASE ( 1 )               !==  Linear formulation function of temperature only  ==! 
     248#  if defined key_vectopt_loop 
     249         DO jj = 1, 1 
     250            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     251#  else 
     252         DO jj = 1, jpjm1 
     253            DO ji = 1, jpim1 
     254#  endif 
     255               ! local 'density/temperature' gradient along i-bathymetric slope 
     256               zgdrho =  ztnb(ji+1,jj) - ztnb(ji,jj)  
     257               ! sign of local i-gradient of density multiplied by the i-slope 
     258               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     259               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
     260               ! 
     261               ! local density gradient along j-bathymetric slope 
     262               zgdrho =  ztnb(ji,jj+1) - ztnb(ji,jj)  
     263               ! sign of local j-gradient of density multiplied by the j-slope 
     264               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     265               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
     266            END DO 
     267         END DO 
     268         ! 
     269      CASE ( 2 )               !==  Linear formulation function of temperature and salinity  ==! 
     270#  if defined key_vectopt_loop 
     271         DO jj = 1, 1 
     272            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     273#  else 
     274         DO jj = 1, jpjm1 
     275            DO ji = 1, jpim1 
    313276#  endif       
    314             ! local density gradient along i-bathymetric slope 
    315             zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
    316                      -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
    317             ! sign of local i-gradient of density multiplied by the i-slope 
    318             zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    319             zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
    320 #  if ! defined key_vectopt_loop 
    321          END DO 
    322 #  endif 
    323       END DO 
    324  
    325 #  if defined key_vectopt_loop 
    326       jj = 1 
    327       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    328 #  else 
    329       DO jj = 1, jpjm1 
    330          DO ji = 1, jpim1 
    331 #  endif      
    332             ! local density gradient along j-bathymetric slope 
    333             zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
    334                      -  ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )    
    335             ! sign of local j-gradient of density multiplied by the j-slope 
    336             zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    337             zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
    338 #  if ! defined key_vectopt_loop 
    339          END DO 
    340 #  endif 
    341       END DO 
    342        
    343       CASE DEFAULT 
    344  
    345          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    346          CALL ctl_stop(ctmp1) 
    347  
     277               ! local density gradient along i-bathymetric slope 
     278               zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
     279                  &       - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
     280               ! sign of local i-gradient of density multiplied by the i-slope 
     281               zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     282               zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 
     283               ! 
     284               ! local density gradient along j-bathymetric slope 
     285               zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
     286                  &       - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )    
     287               ! sign of local j-gradient of density multiplied by the j-slope 
     288               zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     289               zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 
     290            END DO 
     291         END DO 
     292         ! 
    348293      END SELECT 
    349294 
    … …  
    403348      ! second derivative (divergence) and add to the general tracer trend 
    404349#  if defined key_vectopt_loop 
    405       jj = 1 
    406       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     350      DO jj = 1, 1 
     351         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    407352#  else 
    408353      DO jj = 2, jpjm1 
    … …  
    417362            ta(ji,jj,ik) = ta(ji,jj,ik) + zta 
    418363            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 
    419 #  if ! defined key_vectopt_loop 
    420          END DO 
    421 #  endif 
     364         END DO 
    422365      END DO 
    423366 
    … …  
    460403      REAL(wp),  DIMENSION(jpi,jpj) :: zmbk   
    461404 
    462       NAMELIST/nambbl/ atrbbl 
     405      NAMELIST/nambbl/ rn_ahtbbl 
    463406      !!---------------------------------------------------------------------- 
    464407 
    … …  
    470413         WRITE(numout,*) 'tra_bbl_init : ' 
    471414         WRITE(numout,*) '~~~~~~~~~~~~' 
    472          IF (lk_trabbl_dif )   WRITE(numout,*) '               * Diffusive Bottom Boundary Layer' 
     415         IF( lk_trabbl_dif )   WRITE(numout,*) '               * Diffusive Bottom Boundary Layer' 
    473416         IF( lk_trabbl_adv )   WRITE(numout,*) '               * Advective Bottom Boundary Layer' 
    474417         WRITE(numout,*) '       Namelist nambbl : set bbl parameters' 
    475          WRITE(numout,*) '          bottom boundary layer coef.    atrbbl = ', atrbbl 
     418         WRITE(numout,*) '          bottom boundary layer coef.    rn_ahtbbl = ', rn_ahtbbl 
    476419      ENDIF 
    477420  

  • trunk/NEMO/OPA_SRC/TRA/trabbl_adv.h90

    r1482 r1601  
    101101 
    102102#if defined key_vectopt_loop 
    103       jj = 1 
    104       DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     103      DO jj = 1, 1 
     104         DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    105105#else 
    106106      DO jj = 1, jpj 
    … …  
    116116            zunb(ji,jj) = un(ji,jj,mbku(ji,jj))  
    117117            zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj))  
    118 #if ! defined key_vectopt_loop 
    119          END DO 
    120 #endif 
     118         END DO 
    121119      END DO 
    122120 
    … …  
    127125      ! multiplied by the slope of the ocean bottom 
    128126 
    129       SELECT CASE ( neos ) 
     127      SELECT CASE ( nn_eos ) 
    130128      ! 
    131129      CASE ( 0 )               ! Jackett and McDougall (1994) formulation 
    132       ! 
    133       DO jj = 1, jpjm1 
    134          DO ji = 1, fs_jpim1   ! vector opt. 
    135             !   ... temperature, salinity anomalie and depth 
    136             zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
    137             zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
    138             zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    139             !   ... masked ratio alpha/beta 
    140             zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1) 
    141             !   ... local density gradient along i-bathymetric slope 
    142             zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
    143                &       -      ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
    144             zgdrho = zgdrho * umask(ji,jj,1) 
    145             !   ... sign of local i-gradient of density multiplied by the i-slope 
    146             zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    147             zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    148             zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
    149          END DO 
    150       END DO 
    151       ! 
    152       DO jj = 1, jpjm1 
    153          DO ji = 1, fs_jpim1   ! vector opt. 
    154             !   ... temperature, salinity anomalie and depth 
    155             zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
    156             zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
    157             zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    158             !   ... masked ratio alpha/beta 
    159             zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1) 
    160             !   ... local density gradient along j-bathymetric slope 
    161             zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    162                &       -      ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    163             zgdrho = zgdrho*vmask(ji,jj,1) 
    164             !   ... sign of local j-gradient of density multiplied by the j-slope 
    165             zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    166             zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    167             zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
    168          END DO 
    169       END DO 
    170       ! 
     130         ! 
     131         DO jj = 1, jpjm1 
     132            DO ji = 1, fs_jpim1   ! vector opt. 
     133               !   ... temperature, salinity anomalie and depth 
     134               zt = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
     135               zs = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
     136               zh = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
     137               !   ... masked ratio alpha/beta 
     138               zalbet = fsalbt( zt, zs, zh ) * umask(ji,jj,1) 
     139               !   ... local density gradient along i-bathymetric slope 
     140               zgdrho = zalbet * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
     141                  &       -      ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
     142               zgdrho = zgdrho * umask(ji,jj,1) 
     143               !   ... sign of local i-gradient of density multiplied by the i-slope 
     144               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     145               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     146               zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
     147               ! 
     148               !   ... temperature, salinity anomalie and depth 
     149               zt = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
     150               zs = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
     151               zh = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
     152               !   ... masked ratio alpha/beta 
     153               zalbet = fsalbt( zt, zs, zh ) * vmask(ji,jj,1) 
     154               !   ... local density gradient along j-bathymetric slope 
     155               zgdrho = zalbet * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
     156                  &       -      ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
     157               zgdrho = zgdrho*vmask(ji,jj,1) 
     158               !   ... sign of local j-gradient of density multiplied by the j-slope 
     159               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     160               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     161               zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
     162            END DO 
     163         END DO 
     164         ! 
    171165      CASE ( 1 )               ! Linear formulation function of temperature only 
    172       ! 
    173       DO jj = 1, jpjm1 
    174          DO ji = 1, fs_jpim1   ! vector opt. 
    175             ! local 'density/temperature' gradient along i-bathymetric slope 
    176             zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 
    177             ! sign of local i-gradient of density multiplied by the i-slope 
    178             zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    179             zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    180             zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
    181  
    182             ! local density gradient along j-bathymetric slope 
    183             zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 
    184             ! sign of local j-gradient of density multiplied by the j-slope 
    185             zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    186             zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    187             zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
    188          END DO 
    189       END DO 
    190       ! 
     166         ! 
     167         DO jj = 1, jpjm1 
     168            DO ji = 1, fs_jpim1   ! vector opt. 
     169               ! local 'density/temperature' gradient along i-bathymetric slope 
     170               zgdrho =  ( ztnb(ji+1,jj) - ztnb(ji,jj) ) 
     171               ! sign of local i-gradient of density multiplied by the i-slope 
     172               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     173               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     174               zalphax(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
     175               !  
     176               ! local density gradient along j-bathymetric slope 
     177               zgdrho =  ( ztnb(ji,jj+1) - ztnb(ji,jj) ) 
     178               ! sign of local j-gradient of density multiplied by the j-slope 
     179               zsign = SIGN( 0.5, -zgdrho     * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     180               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     181               zalphay(ji,jj)=( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
     182            END DO 
     183         END DO 
     184         ! 
    191185      CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    192       ! 
    193       DO jj = 1, jpjm1 
    194          DO ji = 1, fs_jpim1   ! vector opt.             
    195             ! local density gradient along i-bathymetric slope 
    196             zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
    197                &     -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
    198             ! sign of local i-gradient of density multiplied by the i-slope 
    199             zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    200             zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    201             zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
    202  
    203             ! local density gradient along j-bathymetric slope 
    204             zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
    205                    -    ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )    
    206             ! sign of local j-gradient of density multiplied by the j-slope 
    207             zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    208             zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    209             zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
    210          END DO 
    211       END DO 
    212       ! 
    213       CASE DEFAULT 
    214          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    215          CALL ctl_stop( ctmp1 ) 
     186         ! 
     187         DO jj = 1, jpjm1 
     188            DO ji = 1, fs_jpim1   ! vector opt.             
     189               ! local density gradient along i-bathymetric slope 
     190               zgdrho = - ( rn_beta *( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
     191                  &       - rn_alpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
     192               ! sign of local i-gradient of density multiplied by the i-slope 
     193               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     194               zsigna= SIGN( 0.5, zunb(ji,jj) * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
     195               zalphax(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * umask(ji,jj,1) 
     196               !  
     197               ! local density gradient along j-bathymetric slope 
     198               zgdrho = - ( rn_beta *( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
     199                  &       - rn_alpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )    
     200               ! sign of local j-gradient of density multiplied by the j-slope 
     201               zsign = SIGN( 0.5, - zgdrho    * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     202               zsigna= SIGN( 0.5, zvnb(ji,jj) * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
     203               zalphay(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * vmask(ji,jj,1) 
     204            END DO 
     205         END DO 
    216206         ! 
    217207      END SELECT 
    … …  
    231221       
    232222# if defined key_vectopt_loop 
    233          jj = 1 
    234          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     223         DO jj = 1, 1 
     224            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    235225# else    
    236226         DO jj = 1, jpjm1 
    … …  
    250240                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv)        
    251241               ENDIF 
    252 # if ! defined key_vectopt_loop 
    253             END DO 
    254 # endif 
     242            END DO 
    255243         END DO 
    256244 
    … …  
    261249 
    262250#if defined key_vectopt_loop 
    263          jj = 1 
    264          DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     251         DO jj = 1, 1 
     252            DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    265253#else 
    266254         DO jj = 1, jpj 
    … …  
    273261                  v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv)        
    274262               ENDIF 
    275 #if ! defined key_vectopt_loop 
    276             END DO 
    277 #endif 
     263            END DO 
    278264         END DO 
    279265        
    280266      ENDIF 
    281       
     267 
    282268 
    283269      ! 5. Along sigma advective trend 
    … …  
    286272 
    287273# if defined key_vectopt_loop 
    288       jj = 1 
    289       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     274      DO jj = 1, 1 
     275         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    290276# else 
    291277      DO jj = 1, jpjm1 
    … …  
    310296            zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji  ,jj  )   & 
    311297               &          +( zfvj - ABS( zfvj ) ) * zsbb(ji  ,jj+1) ) * 0.5 
    312 #if ! defined key_vectopt_loop 
    313          END DO 
    314 #endif 
    315         END DO 
    316 # if defined key_vectopt_loop 
    317       jj = 1 
    318       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     298         END DO 
     299      END DO 
     300# if defined key_vectopt_loop 
     301      DO jj = 1, 1 
     302         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    319303# else 
    320304      DO jj = 2, jpjm1 
    … …  
    332316            ta(ji,jj,ik) = ta(ji,jj,ik) + zta 
    333317            sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 
    334 #if ! defined key_vectopt_loop 
    335          END DO 
    336 #endif 
     318         END DO 
    337319      END DO 
    338320 
    … …  
    365347 
    366348      IF( ln_zps ) THEN 
    367      
    368 # if defined key_vectopt_loop 
    369          jj = 1 
    370          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     349  
     350# if defined key_vectopt_loop 
     351         DO jj = 1, 1 
     352            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    371353# else 
    372354         DO jj = 1, jpjm1 
    … …  
    381363               ze3u = MIN( fse3u(ji,jj,iku1), fse3u(ji,jj,iku2) )  
    382364               ze3v = MIN( fse3v(ji,jj,ikv1), fse3v(ji,jj,ikv2) )  
    383            
     365 
    384366               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u   
    385367               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v 
    386 #if ! defined key_vectopt_loop 
    387             END DO 
    388 #endif 
     368            END DO 
    389369         END DO   
    390     
     370         ! 
    391371      ELSE 
    392  
    393 # if defined key_vectopt_loop 
    394          jj = 1 
    395          DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     372         ! 
     373# if defined key_vectopt_loop 
     374         DO jj = 1, 1 
     375            DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    396376# else 
    397377         DO jj = 1, jpjm1 
    … …  
    402382               zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku)  
    403383               zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv)  
    404 #if ! defined key_vectopt_loop 
    405             END DO 
    406 #endif 
    407          END DO 
    408  
     384            END DO 
     385         END DO 
     386         ! 
    409387      ENDIF 
    410388  
    411389 
    412390# if defined key_vectopt_loop 
    413       jj = 1 
    414       DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     391      DO jj = 1, 1 
     392         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    415393# else 
    416394      DO jj = 2, jpjm1 
    … …  
    426404               &   ) / zbt 
    427405 
    428 # if ! defined key_vectopt_loop 
    429          END DO 
    430 # endif 
    431         END DO 
     406         END DO 
     407      END DO 
    432408 
    433409      ! 7. compute additional vertical velocity to be used in t boxes 
    … …  
    442418         END DO 
    443419      END DO 
    444  
    445       ! Boundary condition on w_bbl   (unchanged sign) 
    446       CALL lbc_lnk( w_bbl, 'W', 1. ) 
     420      CALL lbc_lnk( w_bbl, 'W', 1. )      ! Boundary condition on w_bbl   (unchanged sign) 
    447421 
    448422      CALL iom_put( "uoce_bbl", u_bbl )   ! bbl i-current       

  • trunk/NEMO/OPA_SRC/TRA/tradmp.F90

    r1438 r1601  
    44   !! Ocean physics: internal restoring trend on active tracers (T and S) 
    55   !!====================================================================== 
    6    !! History :  5.0  !  91-03  (O. Marti, G. Madec)  Original code 
    7    !!                 !  92-06  (M. Imbard)  doctor norme 
    8    !!                 !  96-01  (G. Madec)  statement function for e3 
    9    !!                 !  97-05  (G. Madec)  macro-tasked on jk-slab 
    10    !!                 !  98-07  (M. Imbard, G. Madec) ORCA version 
    11    !!            7.0  !  01-02  (M. Imbard)  cofdis, Original code 
    12    !!            8.1  !  01-02  (G. Madec, E. Durand)  cleaning 
    13    !!            8.5  !  02-08  (G. Madec, E. Durand)  free form + modules 
     6   !! History :  OPA  ! 1991-03  (O. Marti, G. Madec)  Original code 
     7   !!                 ! 1992-06  (M. Imbard)  doctor norme 
     8   !!                 ! 1996-01  (G. Madec)  statement function for e3 
     9   !!                 ! 1997-05  (G. Madec)  macro-tasked on jk-slab 
     10   !!                 ! 1998-07  (M. Imbard, G. Madec) ORCA version 
     11   !!            7.0  ! 2001-02  (M. Imbard)  cofdis, Original code 
     12   !!            8.1  ! 2001-02  (G. Madec, E. Durand)  cleaning 
     13   !!  NEMO      1.0  ! 2002-08  (G. Madec, E. Durand)  free form + modules 
     14   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter 
    1415   !!---------------------------------------------------------------------- 
    1516#if   defined key_tradmp   ||   defined key_esopa 
    1617   !!---------------------------------------------------------------------- 
    1718   !!   key_tradmp                                         internal damping 
    18    !!---------------------------------------------------------------------- 
    1919   !!---------------------------------------------------------------------- 
    2020   !!   tra_dmp      : update the tracer trend with the internal damping 
    … …  
    2929   USE trdmod_oce      ! ocean variables trends 
    3030   USE zdf_oce         ! ocean vertical physics 
    31    USE in_out_manager  ! I/O manager 
    3231   USE phycst          ! Define parameters for the routines 
    3332   USE dtatem          ! temperature data 
    3433   USE dtasal          ! salinity data 
    3534   USE zdfmxl          ! mixed layer depth 
     35   USE in_out_manager  ! I/O manager 
    3636   USE lib_mpp         ! distribued memory computing 
    3737   USE prtctl          ! Print control 
    … …  
    4040   PRIVATE 
    4141 
    42    PUBLIC tra_dmp      ! routine called by step.F90 
     42   PUBLIC   tra_dmp    ! routine called by step.F90 
    4343 
    4444#if ! defined key_agrif 
    … …  
    4949   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   resto    !: restoring coeff. on T and S (s-1) 
    5050    
    51    !!* newtonian damping namelist (mandmp)  
    52    INTEGER  ::   ndmp   =   -1    ! = 0/-1/'latitude' for damping over T and S 
    53    INTEGER  ::   ndmpf  =    2    ! = 1 create a damping.coeff NetCDF file  
    54    INTEGER  ::   nmldmp =    0    ! = 0/1/2 flag for damping in the mixed layer 
    55    REAL(wp) ::   sdmp   =   50.   ! surface time scale for internal damping (days) 
    56    REAL(wp) ::   bdmp   =  360.   ! bottom time scale for internal damping (days) 
    57    REAL(wp) ::   hdmp   =  800.   ! depth of transition between sdmp and bdmp (meters) 
     51   !                             !!* Namelist namtra_dmp : T & S newtonian damping * 
     52   INTEGER  ::   nn_hdmp =   -1   ! = 0/-1/'latitude' for damping over T and S 
     53   INTEGER  ::   nn_zdmp =    0   ! = 0/1/2 flag for damping in the mixed layer 
     54   REAL(wp) ::   rn_surf =   50.  ! surface time scale for internal damping        [days] 
     55   REAL(wp) ::   rn_bot  =  360.  ! bottom time scale for internal damping         [days] 
     56   REAL(wp) ::   rn_dep  =  800.  ! depth of transition between rn_surf and rn_bot [meters] 
     57   INTEGER  ::   nn_file =    2   ! = 1 create a damping.coeff NetCDF file  
    5858 
    5959   !! * Substitutions 
    … …  
    6161#  include "vectopt_loop_substitute.h90" 
    6262   !!---------------------------------------------------------------------- 
    63    !!   OPA 9.0 , LOCEAN-IPSL (2006)  
     63   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    6464   !! $Id$  
    6565   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    8484      !!      below the well mixed layer (nlmdmp=2) 
    8585      !! 
    86       !! ** Action  : - update the tracer trends (ta,sa) with the newtonian  
    87       !!                damping trends. 
    88       !!              - save the trends in (ttrd,strd) ('key_trdtra') 
     86      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend 
    8987      !!---------------------------------------------------------------------- 
    9088      USE oce, ONLY :   ztrdt => ua   ! use ua as 3D workspace    
    9189      USE oce, ONLY :   ztrds => va   ! use va as 3D workspace    
    9290      !! 
    93       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    94       !! 
    95       INTEGER  ::   ji, jj, jk            ! dummy loop indices 
    96       REAL(wp) ::   ztest, zta, zsa       ! temporary scalars 
     91      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     92      !! 
     93      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    9794      !!---------------------------------------------------------------------- 
    9895 
    … …  
    104101      ENDIF 
    105102 
    106       ! 1. Newtonian damping trends on tracer fields 
    107       ! -------------------------------------------- 
    108       !    compute the newtonian damping trends depending on nmldmp 
    109  
    110       SELECT CASE ( nmldmp ) 
     103      SELECT CASE ( nn_zdmp )  
    111104      ! 
    112       CASE( 0 )                ! newtonian damping throughout the water column 
     105      CASE( 0 )                   !==  newtonian damping throughout the water column  ==! 
    113106         DO jk = 1, jpkm1 
    114107            DO jj = 2, jpjm1 
    115108               DO ji = fs_2, fs_jpim1   ! vector opt. 
    116                   zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
    117                   zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    118                   ! add the trends to the general tracer trends 
    119                   ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    120                   sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
    121                   ! save the salinity trend (used in flx to close the salt budget) 
     109                  ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
     110                  sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    122111               END DO 
    123112            END DO 
    124113         END DO 
    125114         ! 
    126       CASE ( 1 )                ! no damping in the turbocline (avt > 5 cm2/s) 
     115      CASE ( 1 )                  !==  no damping in the turbocline (avt > 5 cm2/s)  ==! 
    127116         DO jk = 1, jpkm1 
    128117            DO jj = 2, jpjm1 
    129118               DO ji = fs_2, fs_jpim1   ! vector opt. 
    130                   ztest = avt(ji,jj,jk) - 5.e-4 
    131                   IF( ztest < 0. ) THEN 
    132                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
    133                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    134                   ELSE 
    135                      zta = 0.e0 
    136                      zsa = 0.e0 
     119                  IF( avt(ji,jj,jk) <= 5.e-4 ) THEN 
     120                     ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
     121                     sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    137122                  ENDIF 
    138                   ! add the trends to the general tracer trends 
    139                   ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    140                   sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
    141                   ! save the salinity trend (used in flx to close the salt budget) 
    142123               END DO 
    143124            END DO 
    144125         END DO 
    145126         ! 
    146       CASE ( 2 )                ! no damping in the mixed layer  
     127      CASE ( 2 )                  !==  no damping in the mixed layer   ==! 
    147128         DO jk = 1, jpkm1 
    148129            DO jj = 2, jpjm1 
    149130               DO ji = fs_2, fs_jpim1   ! vector opt. 
    150131                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    151                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
    152                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    153                   ELSE 
    154                      zta = 0.e0 
    155                      zsa = 0.e0 
     132                     ta(ji,jj,jk) = ta(ji,jj,jk) + resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tb(ji,jj,jk) ) 
     133                     sa(ji,jj,jk) = sa(ji,jj,jk) + resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - sb(ji,jj,jk) ) 
    156134                  ENDIF 
    157                   ! add the trends to the general tracer trends 
    158                   ta(ji,jj,jk) = ta(ji,jj,jk) + zta 
    159                   sa(ji,jj,jk) = sa(ji,jj,jk) + zsa 
    160                   ! save the salinity trend (used in flx to close the salt budget) 
    161135               END DO 
    162136            END DO 
    … …  
    165139      END SELECT 
    166140 
    167       IF( l_trdtra )   THEN          ! save the damping tracer trends for diagnostic 
     141      IF( l_trdtra )   THEN       ! trend diagnostic 
    168142         ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 
    169143         ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 
    170          CALL trd_mod(ztrdt, ztrds, jptra_trd_dmp, 'TRA', kt) 
     144         CALL trd_mod( ztrdt, ztrds, jptra_trd_dmp, 'TRA', kt ) 
    171145      ENDIF 
    172       !                              ! Control print 
     146      !                           ! Control print 
    173147      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ta, clinfo1=' dmp  - Ta: ', mask1=tmask,   & 
    174148         &                       tab3d_2=sa, clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    … …  
    184158      !! 
    185159      !! ** Method  :   read the nammbf namelist and check the parameters 
    186       !!      called by tra_dmp at the first timestep (nit000) 
    187       !!---------------------------------------------------------------------- 
    188       NAMELIST/namtdp/ ndmp, ndmpf, nmldmp, sdmp, bdmp, hdmp 
    189       !!---------------------------------------------------------------------- 
    190  
    191       REWIND ( numnam )                  ! Read Namelist namtdp : temperature and salinity damping term 
    192       READ   ( numnam, namtdp ) 
    193       IF( lzoom )   nmldmp = 0           ! restoring to climatology at closed north or south boundaries 
     160      !!---------------------------------------------------------------------- 
     161      NAMELIST/namtra_dmp/ nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
     162      !!---------------------------------------------------------------------- 
     163 
     164      REWIND ( numnam )                  ! Read Namelist namtra_dmp : temperature and salinity damping term 
     165      READ   ( numnam, namtra_dmp ) 
     166      IF( lzoom )   nn_zdmp = 0           ! restoring to climatology at closed north or south boundaries 
    194167 
    195168      IF(lwp) THEN                       ! Namelist print 
    … …  
    197170         WRITE(numout,*) 'tra_dmp : T and S newtonian damping' 
    198171         WRITE(numout,*) '~~~~~~~' 
    199          WRITE(numout,*) '       Namelist namtdp : set damping parameter' 
    200          WRITE(numout,*) '          T and S damping option         ndmp   = ', ndmp 
    201          WRITE(numout,*) '          create a damping.coeff file    ndmpf  = ', ndmpf 
    202          WRITE(numout,*) '          mixed layer damping option     nmldmp = ', nmldmp, '(zoom: forced to 0)' 
    203          WRITE(numout,*) '          surface time scale (days)      sdmp   = ', sdmp 
    204          WRITE(numout,*) '          bottom time scale (days)       bdmp   = ', bdmp 
    205          WRITE(numout,*) '          depth of transition (meters)   hdmp   = ', hdmp 
     172         WRITE(numout,*) '   Namelist namtra_dmp : set damping parameter' 
     173         WRITE(numout,*) '      T and S damping option         nn_hdmp = ', nn_hdmp 
     174         WRITE(numout,*) '      mixed layer damping option     nn_zdmp = ', nn_zdmp, '(zoom: forced to 0)' 
     175         WRITE(numout,*) '      surface time scale (days)      rn_surf = ', rn_surf 
     176         WRITE(numout,*) '      bottom time scale (days)       rn_bot  = ', rn_bot 
     177         WRITE(numout,*) '      depth of transition (meters)   rn_dep  = ', rn_dep 
     178         WRITE(numout,*) '      create a damping.coeff file    nn_file = ', nn_file 
    206179      ENDIF 
    207180 
    208       SELECT CASE ( ndmp ) 
    209       CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '          tracer damping in the Med & Red seas only' 
    210       CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '          tracer damping poleward of', ndmp, ' degrees' 
     181      SELECT CASE ( nn_hdmp ) 
     182      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
     183      CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees' 
    211184      CASE DEFAULT 
    212          WRITE(ctmp1,*) '          bad flag value for ndmp = ', ndmp 
     185         WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp 
    213186         CALL ctl_stop(ctmp1) 
    214187      END SELECT 
    215188 
    216       SELECT CASE ( nmldmp ) 
    217       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '          tracer damping throughout the water column' 
    218       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '          no tracer damping in the turbocline (avt > 5 cm2/s)' 
    219       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '          no tracer damping in the mixed layer' 
     189      SELECT CASE ( nn_zdmp ) 
     190      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     191      CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     192      CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    220193      CASE DEFAULT 
    221          WRITE(ctmp1,*) '          bad flag value for nmldmp = ', nmldmp 
     194         WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 
    222195         CALL ctl_stop(ctmp1) 
    223196      END SELECT 
    … …  
    241214      !! 
    242215      !! ** Method  : - set along closed boundary due to zoom a damping over 
    243       !!      6 points with a max time scale of 5 days. 
     216      !!                6 points with a max time scale of 5 days. 
    244217      !!              - ORCA arctic/antarctic zoom: set the damping along 
    245       !!      south/north boundary over a latitude strip. 
     218      !!                south/north boundary over a latitude strip. 
    246219      !! 
    247220      !! ** Action  : - resto, the damping coeff. for T and S 
    … …  
    270243      END DO 
    271244 
    272  
    273       IF( lzoom_arct .AND. lzoom_anta ) THEN 
    274          ! 
    275          ! ==================================================== 
    276          !  ORCA configuration : arctic zoom or antarctic zoom 
    277          ! ==================================================== 
    278  
     245      !                                           ! ==================================================== 
     246      IF( lzoom_arct .AND. lzoom_anta ) THEN      !  ORCA configuration : arctic zoom or antarctic zoom 
     247         !                                        ! ==================================================== 
    279248         IF(lwp) WRITE(numout,*) 
    280249         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom' 
    281250         IF(lwp .AND. lzoom_arct ) WRITE(numout,*) '              dtacof_zoom : ORCA Antarctic zoom' 
    282251         IF(lwp) WRITE(numout,*) 
    283  
    284          ! ... Initialization :  
    285          !     zlat0 : latitude strip where resto decreases 
    286          !     zlat1 : resto = 1 before zlat1 
    287          !     zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2 
     252         ! 
     253         !                          ! Initialization :  
    288254         resto(:,:,:) = 0.e0 
    289          zlat0 = 10. 
    290          zlat1 = 30. 
    291          zlat2 = zlat1 + zlat0 
    292  
    293          ! ... Compute arrays resto ; value for internal damping : 5 days 
    294          DO jk = 2, jpkm1 
     255         zlat0 = 10.                     ! zlat0 : latitude strip where resto decreases 
     256         zlat1 = 30.                     ! zlat1 : resto = 1 before zlat1 
     257         zlat2 = zlat1 + zlat0           ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2 
     258 
     259         DO jk = 2, jpkm1           ! Compute arrays resto ; value for internal damping : 5 days 
    295260            DO jj = 1, jpj 
    296261               DO ji = 1, jpi 
    297262                  zlat = ABS( gphit(ji,jj) ) 
    298                   IF ( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN 
    299                      resto(ji,jj,jk) = 0.5 * ( 1./(5.*rday) ) *   & 
    300                         ( 1. - cos(rpi*(zlat2-zlat)/zlat0) )  
    301                   ELSE IF ( zlat < zlat1 ) THEN 
     263                  IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN 
     264                     resto(ji,jj,jk) = 0.5 * ( 1./(5.*rday) ) * ( 1. - cos(rpi*(zlat2-zlat)/zlat0) )  
     265                  ELSEIF( zlat < zlat1 ) THEN 
    302266                     resto(ji,jj,jk) = 1./(5.*rday) 
    303267                  ENDIF 
    … …  
    307271         ! 
    308272      ENDIF 
    309  
    310       ! ... Mask resto array 
     273      !                             ! Mask resto array 
    311274      resto(:,:,:) = resto(:,:,:) * tmask(:,:,:) 
    312275      ! 
    … …  
    321284      !! 
    322285      !! ** Method  :   Arrays defining the damping are computed for each grid 
    323       !!      point for temperature and salinity (resto) 
    324       !!      Damping depends on distance to coast, depth and latitude 
     286      !!                point for temperature and salinity (resto) 
     287      !!                Damping depends on distance to coast, depth and latitude 
    325288      !! 
    326289      !! ** Action  : - resto, the damping coeff. for T and S 
    … …  
    330293      !! 
    331294      INTEGER ::   ji, jj, jk                   ! dummy loop indices 
    332       INTEGER ::   ii0, ii1, ij0, ij1           !    "          " 
     295      INTEGER ::   ii0, ii1, ij0, ij1           !    -          - 
    333296      INTEGER ::   inum0                        ! logical unit for file restoring damping term 
    334297      INTEGER ::   icot                         ! logical unit for file distance to the coast 
    335298      REAL(wp) ::   zinfl, zlon                 ! temporary scalars 
    336       REAL(wp) ::   zlat, zlat0, zlat1, zlat2   !    "         " 
    337       REAL(wp) ::   zsdmp, zbdmp                !    "         " 
     299      REAL(wp) ::   zlat, zlat0, zlat1, zlat2   !    -         - 
     300      REAL(wp) ::   zsdmp, zbdmp                !    -         - 
    338301      REAL(wp), DIMENSION(jpk)         ::   zhfac 
    339302      REAL(wp), DIMENSION(jpi,jpj)     ::   zmrs 
    … …  
    350313 
    351314      ! ... Initialization :  
    352       !   zdct()      : distant to the coastline 
    353       !   resto()     : array of restoring coeff. on T and S 
    354  
    355315      resto(:,:,:) = 0.e0 
    356316 
    357       IF ( ndmp > 0 ) THEN 
    358  
    359          !    ------------------------------------ 
    360          !     Damping poleward of 'ndmp' degrees 
    361          !    ------------------------------------ 
    362  
     317      !                           !-----------------------------------------! 
     318      IF( nn_hdmp > 0 ) THEN      !  Damping poleward of 'nn_hdmp' degrees  ! 
     319         !                        !-----------------------------------------! 
    363320         IF(lwp) WRITE(numout,*) 
    364          IF(lwp) WRITE(numout,*) '              Damping poleward of ', ndmp,' deg.' 
    365          IF(lwp) WRITE(numout,*) 
    366  
    367          ! ... Distance to coast (zdct) 
    368  
    369          IF(lwp) WRITE(numout,*) 
    370          IF(lwp) WRITE(numout,*) ' dtacof : distance to coast file' 
     321         IF(lwp) WRITE(numout,*) '              Damping poleward of ', nn_hdmp,' deg.' 
     322         ! 
    371323         CALL iom_open ( 'dist.coast.nc', icot, ldstop = .FALSE. ) 
    372          IF( icot > 0 ) THEN 
    373             CALL iom_get ( icot, jpdom_data, 'Tcoast', zdct ) 
    374             CALL iom_close (icot) 
    375          ELSE 
    376             !   ... Compute and save the distance-to-coast array (output in zdct) 
     324         ! 
     325         IF( icot > 0 ) THEN          ! distance-to-coast read in file 
     326            CALL iom_get  ( icot, jpdom_data, 'Tcoast', zdct ) 
     327            CALL iom_close( icot ) 
     328         ELSE                         ! distance-to-coast computed and saved in file (output in zdct) 
    377329            CALL cofdis( zdct ) 
    378330         ENDIF 
    379331 
    380          ! ... Compute arrays resto  
    381          !      zinfl : distance of influence for damping term 
    382          !      zlat0 : latitude strip where resto decreases 
    383          !      zlat1 : resto = 0 between -zlat1 and zlat1 
    384          !      zlat2 : resto increases from 0 to 1 between |zlat1| and |zlat2| 
    385          !          and resto = 1 between |zlat2| and 90 deg. 
    386          zinfl = 1000.e3 
    387          zlat0 = 10 
    388          zlat1 = ndmp 
    389          zlat2 = zlat1 + zlat0 
     332         !                            ! Compute arrays resto  
     333         zinfl = 1000.e3                   ! distance of influence for damping term 
     334         zlat0 = 10.                       ! latitude strip where resto decreases 
     335         zlat1 = REAL( nn_hdmp )           ! resto = 0 between -zlat1 and zlat1 
     336         zlat2 = zlat1 + zlat0             ! resto increases from 0 to 1 between |zlat1| and |zlat2| 
    390337 
    391338         DO jj = 1, jpj 
    … …  
    400347         END DO 
    401348 
    402          !   ... North Indian ocean (20N/30N x 45E/100E) : resto=0 
    403          IF ( ndmp == 20 ) THEN 
     349         IF ( nn_hdmp == 20 ) THEN       ! North Indian ocean (20N/30N x 45E/100E) : resto=0 
    404350            DO jj = 1, jpj 
    405351               DO ji = 1, jpi 
    406352                  zlat = gphit(ji,jj) 
    407353                  zlon = MOD( glamt(ji,jj), 360. ) 
    408                   IF ( zlat1 < zlat .AND. zlat < zlat2 .AND.   & 
    409                      45.  < zlon .AND. zlon < 100. ) THEN 
    410                      resto(ji,jj,1) = 0. 
     354                  IF ( zlat1 < zlat .AND. zlat < zlat2 .AND. 45. < zlon .AND. zlon < 100. ) THEN 
     355                     resto(ji,jj,1) = 0.e0 
    411356                  ENDIF 
    412357               END DO 
    … …  
    414359         ENDIF 
    415360 
    416          zsdmp = 1./(sdmp * rday) 
    417          zbdmp = 1./(bdmp * rday) 
     361         zsdmp = 1./(rn_surf * rday) 
     362         zbdmp = 1./(rn_bot * rday) 
    418363         DO jk = 2, jpkm1 
    419364            DO jj = 1, jpj 
    … …  
    423368                  resto(ji,jj,jk) = resto(ji,jj,1) * 0.5 * ( 1. - COS( rpi*zdct(ji,jj,jk)/zinfl) ) 
    424369                  !   ... Vertical variation from zsdmp (sea surface) to zbdmp (bottom) 
    425                   resto(ji,jj,jk) = resto(ji,jj,jk)      * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/hdmp) ) 
     370                  resto(ji,jj,jk) = resto(ji,jj,jk)      * ( zbdmp + (zsdmp-zbdmp)*EXP(-fsdept(ji,jj,jk)/rn_dep) ) 
    426371               END DO 
    427372            END DO 
    … …  
    431376 
    432377 
    433       IF( cp_cfg == "orca" .AND. ( ndmp > 0 .OR. ndmp == -1 ) ) THEN 
     378      IF( cp_cfg == "orca" .AND. ( nn_hdmp > 0 .OR. nn_hdmp == -1 ) ) THEN 
    434379 
    435380         !                                         ! ========================= 
    … …  
    520465               zmrs( ji , mj0(ij0):mj1(ij1) ) = 0.1 * ABS( FLOAT(ji - mi1(ii1)) ) 
    521466            END DO  
    522             zsdmp = 1./(sdmp * rday) 
    523             zbdmp = 1./(bdmp * rday) 
     467            zsdmp = 1./(rn_surf * rday) 
     468            zbdmp = 1./(rn_bot * rday) 
    524469            DO jk = 1, jpk 
    525                zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/hdmp) ) 
     470               zhfac (jk) = ( zbdmp + (zsdmp-zbdmp) * EXP(-fsdept(1,1,jk)/rn_dep) ) 
    526471            END DO 
    527472            !                                       ! ======================== 
    … …  
    540485         resto(:,:, 1 ) = 0.e0 
    541486         resto(:,:,jpk) = 0.e0 
    542  
    543       ELSE 
    544          !    ------------ 
    545          !     No damping 
    546          !    ------------ 
    547          CALL ctl_stop( 'Choose a correct value of ndmp or DO NOT defined key_tradmp' ) 
     487         !                         !--------------------! 
     488      ELSE                         !     No damping     ! 
     489         !                         !--------------------! 
     490         CALL ctl_stop( 'Choose a correct value of nn_hdmp or DO NOT defined key_tradmp' ) 
    548491      ENDIF 
    549492 
    550       !    ---------------------------- 
    551       !     Create Print damping array 
    552       !    ---------------------------- 
    553  
    554       ! ndmpf   : = 1 create a damping.coeff NetCDF file 
    555  
    556       IF( ndmpf == 1 ) THEN 
     493      !                            !--------------------------------! 
     494      IF( nn_file == 1 ) THEN      !  save damping coef. in a file  ! 
     495         !                         !--------------------------------! 
    557496         IF(lwp) WRITE(numout,*) '              create damping.coeff.nc file' 
    558497         CALL iom_open  ( 'damping.coeff', inum0, ldwrt = .TRUE., kiolib = jprstlib ) 

  • trunk/NEMO/OPA_SRC/TRA/traldf.F90

    r1152 r1601  
    113113      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
    114114      !! 
    115       !! ** Method  :   set nldf from the nam_traldf logicals 
     115      !! ** Method  :   set nldf from the namtra_ldf logicals 
    116116      !!      nldf == -1   ESOPA test: ALL operators are used 
    117117      !!      nldf ==  0   laplacian operator 
    … …  
    122122      INTEGER ::   ioptio, ierr         ! temporary integers  
    123123!       
    124 !     NAMELIST/nam_traldf/ ln_traldf_lap  , ln_traldf_bilap,                & 
    125 !        &                 ln_traldf_level, ln_traldf_hor, ln_traldf_iso,   & 
    126 !        &                 aht0, ahtb0, aeiv0 
     124!     NAMELIST/namtra_ldf/ ln_traldf_lap  , ln_traldf_bilap,                  & 
     125!        &                 ln_traldf_level, ln_traldf_hor  , ln_traldf_iso,   & 
     126!        &                 rn_aht_0       , rn_ahtb_0      , rn_aeiv_0 
    127127      !!---------------------------------------------------------------------- 
    128128 
    … …  
    130130      ! =============================================== 
    131131     
    132       ! Namelist nam_traldf already read in ldftra module 
    133 !     ! Read Namelist nam_traldf : Lateral physics on tracers 
    134 !     REWIND( numnam ) 
    135 !     READ  ( numnam, nam_traldf ) 
     132!     REWIND( numnam )                ! Namelist namtra_ldf already read in ldftra module 
     133!     READ  ( numnam, namtra_ldf )     
    136134 
    137135      IF(lwp) THEN                    ! Namelist print 
    … …  
    139137         WRITE(numout,*) 'tra:ldf_ctl : lateral tracer diffusive operator' 
    140138         WRITE(numout,*) '~~~~~~~~~~~' 
    141          WRITE(numout,*) '       Namelist nam_traldf : set lateral mixing parameters (type, direction, coefficients)' 
    142          WRITE(numout,*) '          laplacian operator          ln_traldf_lap   = ', ln_traldf_lap 
    143          WRITE(numout,*) '          bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap 
    144          WRITE(numout,*) '          iso-level                   ln_traldf_level = ', ln_traldf_level 
    145          WRITE(numout,*) '          horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor 
    146          WRITE(numout,*) '          iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso 
     139         WRITE(numout,*) '   Namelist namtra_ldf : set lateral mixing parameters (type, direction, coefficients)' 
     140         WRITE(numout,*) '      laplacian operator          ln_traldf_lap   = ', ln_traldf_lap 
     141         WRITE(numout,*) '      bilaplacian operator        ln_traldf_bilap = ', ln_traldf_bilap 
     142         WRITE(numout,*) '      iso-level                   ln_traldf_level = ', ln_traldf_level 
     143         WRITE(numout,*) '      horizontal (geopotential)   ln_traldf_hor   = ', ln_traldf_hor 
     144         WRITE(numout,*) '      iso-neutral                 ln_traldf_iso   = ', ln_traldf_iso 
    147145      ENDIF 
    148146 

  • trunk/NEMO/OPA_SRC/TRA/tranxt.F90

    r1438 r1601  
    2626   USE zdf_oce         ! ??? 
    2727   USE domvvl          ! variable volume 
    28    USE dynspg_oce      ! surface pressure gradient variables 
     28   USE dynspg_oce      ! surface     pressure gradient variables 
     29   USE dynhpg          ! hydrostatic pressure gradient  
    2930   USE trdmod_oce      ! ocean variables trends 
    3031   USE trdmod          ! ocean active tracers trends  

  • trunk/NEMO/OPA_SRC/TRA/traqsr.F90

    r1460 r1601  
    3333   PUBLIC   tra_qsr        ! routine called by step.F90 (ln_traqsr=T) 
    3434 
    35    !                                           !!* Namelist namqsr: penetrative solar radiation 
     35   !                                           !!* Namelist namtra_qsr: penetrative solar radiation 
    3636   LOGICAL , PUBLIC ::   ln_traqsr  = .TRUE.    !: light absorption (qsr) flag 
    3737   LOGICAL , PUBLIC ::   ln_qsr_rgb = .FALSE.   !: Red-Green-Blue light absorption flag   
    … …  
    220220      !! ** Method  :   The profile of solar radiation within the ocean is set 
    221221      !!      from two length scale of penetration (rn_si0,rn_si1) and a ratio 
    222       !!      (rn_abs). These parameters are read in the namqsr namelist. The 
     222      !!      (rn_abs). These parameters are read in the namtra_qsr namelist. The 
    223223      !!      default values correspond to clear water (type I in Jerlov'  
    224224      !!      (1968) classification. 
    … …  
    240240      CHARACTER(len=100) ::   cn_dir   ! Root directory for location of ssr files 
    241241      TYPE(FLD_N)        ::   sn_chl   ! informations about the chlorofyl field to be read 
    242       NAMELIST/namqsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   & 
    243          &              nn_chldta, rn_abs, rn_si0, rn_si1, rn_si2 
     242      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio,   & 
     243         &                  nn_chldta, rn_abs, rn_si0, rn_si1, rn_si2 
    244244      !!---------------------------------------------------------------------- 
    245245 
    … …  
    250250      sn_chl = FLD_N( 'chlorophyll' ,    -1     ,  'CHLA'    ,  .true.     , .true.  ,   'yearly'  , ''       , ''         ) 
    251251      ! 
    252       REWIND( numnam )            ! Read Namelist namqsr : ratio and length of penetration 
    253       READ  ( numnam, namqsr ) 
     252      REWIND( numnam )            ! Read Namelist namtra_qsr : ratio and length of penetration 
     253      READ  ( numnam, namtra_qsr ) 
    254254      ! 
    255255      IF(lwp) THEN                ! control print 
    … …  
    257257         WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation' 
    258258         WRITE(numout,*) '~~~~~~~~~~~~' 
    259          WRITE(numout,*) '    Namelist namqsr : set the parameter of penetration' 
    260          WRITE(numout,*) '        Light penetration (T) or not (F)         ln_traqsr  = ', ln_traqsr 
    261          WRITE(numout,*) '        RGB (Red-Green-Blue) light penetration   ln_qsr_rgb = ', ln_qsr_rgb 
    262          WRITE(numout,*) '        2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd 
    263          WRITE(numout,*) '        bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
    264          WRITE(numout,*) '        RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta 
    265          WRITE(numout,*) '        RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
    266          WRITE(numout,*) '        RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
    267          WRITE(numout,*) '        2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
    268          WRITE(numout,*) '        3 bands: longest depth of extinction         rn_si2 = ', rn_si2 
     259         WRITE(numout,*) '   Namelist namtra_qsr : set the parameter of penetration' 
     260         WRITE(numout,*) '      Light penetration (T) or not (F)         ln_traqsr  = ', ln_traqsr 
     261         WRITE(numout,*) '      RGB (Red-Green-Blue) light penetration   ln_qsr_rgb = ', ln_qsr_rgb 
     262         WRITE(numout,*) '      2 band               light penetration   ln_qsr_2bd = ', ln_qsr_2bd 
     263         WRITE(numout,*) '      bio-model            light penetration   ln_qsr_bio = ', ln_qsr_bio 
     264         WRITE(numout,*) '      RGB : Chl data (=1) or cst value (=0)    nn_chldta  = ', nn_chldta 
     265         WRITE(numout,*) '      RGB & 2 bands: fraction of light (rn_si1)    rn_abs = ', rn_abs 
     266         WRITE(numout,*) '      RGB & 2 bands: shortess depth of extinction  rn_si0 = ', rn_si0 
     267         WRITE(numout,*) '      2 bands: longest depth of extinction         rn_si1 = ', rn_si1 
     268         WRITE(numout,*) '      3 bands: longest depth of extinction         rn_si2 = ', rn_si2 
    269269      ENDIF 
    270270 
    271271      IF( ln_traqsr ) THEN     ! control consistency 
    272272         !                       
    273          IF( .NOT. lk_qsr_bio  ) THEN  
     273         IF( .NOT.lk_qsr_bio .AND. ln_qsr_bio )   THEN 
     274            CALL ctl_warn( 'No bio model : force ln_qsr_bio = FALSE ' ) 
    274275            ln_qsr_bio = .FALSE. 
    275             CALL ctl_warn( 'No bio model ;  force bio-model light penetration ln_qsr_bio  = FALSE ' ) 
    276276         ENDIF 
    277277         ! 
    … …  
    286286            ln_qsr_2bd = .FALSE. 
    287287            ln_qsr_bio = .FALSE. 
    288             CALL ctl_warn( '          Choose ONE type of light penetration in namelist namqsr',   & 
     288            CALL ctl_warn( '          Choose ONE type of light penetration in namelist namtra_qsr',   & 
    289289           &               ' otherwise, we force the model to run with RGB light penetration' ) 
    290290         ENDIF 
    … …  
    335335               !                                        ! fill sf_chl with sn_chl and control print 
    336336               CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   & 
    337                   &                                         'Solar penetration function of read chlorophyll', 'namqsr' ) 
     337                  &                                         'Solar penetration function of read chlorophyll', 'namtra_qsr' ) 
    338338               ! 
    339339            ELSE                                !* constant Chl : compute once for all the distribution of light (etot3) 

  • trunk/NEMO/OPA_SRC/TRD/trdicp.F90

    r1152 r1601  
    6060      !!  
    6161      !! ** Purpose : verify the basin averaged properties of tracers and/or 
    62       !!              momentum equations at every time step frequency ntrd. 
     62      !!              momentum equations at every time step frequency nn_trd. 
    6363      !!---------------------------------------------------------------------- 
    6464      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   ptrd2dx             ! Temperature or U trend  
    … …  
    186186      !!  
    187187      !! ** Purpose : verify the basin averaged properties of tracers and/or 
    188       !!              momentum equations at every time step frequency ntrd. 
     188      !!              momentum equations at every time step frequency nn_trd. 
    189189      !!---------------------------------------------------------------------- 
    190190      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptrd3dx            ! Temperature or U trend  
    … …  
    386386      ! ------------------- 
    387387 
    388       IF( MOD(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 
     388      IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 
    389389 
    390390         ! I.1 Conversion potential energy - kinetic energy 
    … …  
    588588      ! ----------------- 
    589589 
    590       IF( MOD(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 
     590      IF( MOD(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend ) THEN 
    591591 
    592592         ! I.1 Sums over the global domain 

  • trunk/NEMO/OPA_SRC/TRD/trdicp_oce.F90

    r1152 r1601  
    1414   PUBLIC 
    1515 
    16    !! * Shared module variables 
    1716#if  defined key_trdtra   &&   defined key_trddyn    ||   defined key_esopa 
    1817   LOGICAL, PARAMETER ::   lk_trdtra = .TRUE.    !: tracers  trend flag 
    … …  
    2928#endif 
    3029 
    31    !! Tracers trends diagnostics parameters 
    32    !!--------------------------------------------------------------------- 
    33    INTEGER, PARAMETER ::   &  !: => tracer trends indexes <= 
    34         jpicpt_xad =  1,   &  !: x- horizontal advection 
    35         jpicpt_yad =  2,   &  !: y- horizontal advection 
    36         jpicpt_zad =  3,   &  !: z- vertical   advection 
    37         jpicpt_ldf =  4,   &  !: lateral       diffusion 
    38         jpicpt_zdf =  5,   &  !: vertical diffusion (Kz) 
    39         jpicpt_bbc =  6,   &  !: Bottom Boundary Condition (geoth. flux)  
    40         jpicpt_bbl =  7,   &  !: Bottom Boundary Layer (diffusive/convective) 
    41         jpicpt_npc =  8,   &  !: static instability mixing 
    42         jpicpt_dmp =  9,   &  !: damping 
    43         jpicpt_qsr = 10,   &  !: penetrative solar radiation 
    44         jpicpt_nsr = 11,   &  !: non solar radiation 
    45         jpicpt_zl1 = 12       !: first level vertical flux 
     30   !                                        !!! => tracer trends indexes <= 
     31   INTEGER, PARAMETER ::   jpicpt_xad =  1   !: x- horizontal advection 
     32   INTEGER, PARAMETER ::   jpicpt_yad =  2   !: y- horizontal advection 
     33   INTEGER, PARAMETER ::   jpicpt_zad =  3   !: z- vertical   advection 
     34   INTEGER, PARAMETER ::   jpicpt_ldf =  4   !: lateral       diffusion 
     35   INTEGER, PARAMETER ::   jpicpt_zdf =  5   !: vertical diffusion (Kz) 
     36   INTEGER, PARAMETER ::   jpicpt_bbc =  6   !: Bottom Boundary Condition (geoth. flux)  
     37   INTEGER, PARAMETER ::   jpicpt_bbl =  7   !: Bottom Boundary Layer (diffusive/convective) 
     38   INTEGER, PARAMETER ::   jpicpt_npc =  8   !: static instability mixing 
     39   INTEGER, PARAMETER ::   jpicpt_dmp =  9   !: damping 
     40   INTEGER, PARAMETER ::   jpicpt_qsr = 10   !: penetrative solar radiation 
     41   INTEGER, PARAMETER ::   jpicpt_nsr = 11   !: non solar radiation 
     42   INTEGER, PARAMETER ::   jpicpt_zl1 = 12   !: first level vertical flux 
    4643 
    47    INTEGER, PARAMETER ::   &  !: => Total tracer trends indexes <= 
    48         jptot_tra = 12        !: change it when adding/removing one indice above 
     44   !                                        !!! => Total tracer trends indexes <= 
     45   INTEGER, PARAMETER ::   jptot_tra  = 12   !: change it when adding/removing one indice above 
    4946    
    50    !! Momentum trends diagnostics parameters 
    51    !!--------------------------------------------------------------------- 
    52    INTEGER, PARAMETER ::   &  !: => dynamic trends indexes <= 
    53         jpicpd_hpg =  1,   &  !: hydrostatic pressure gradient  
    54         jpicpd_keg =  2,   &  !: kinetic energy gradient 
    55         jpicpd_rvo =  3,   &  !: relative vorticity 
    56         jpicpd_pvo =  4,   &  !: planetary vorticity 
    57         jpicpd_ldf =  5,   &  !: lateral diffusion 
    58         jpicpd_had =  6,   &  !: horizontal advection 
    59         jpicpd_zad =  7,   &  !: vertical advection 
    60         jpicpd_zdf =  8,   &  !: vertical diffusion 
    61         jpicpd_spg =  9,   &  !: surface pressure gradient 
    62         jpicpd_dat = 10,   &  !: damping term 
    63         jpicpd_swf = 11,   &  !: surface wind forcing 
    64         jpicpd_bfr = 12       !: bottom friction  
     47   !                                        !!! => dynamic trends indexes <= 
     48   INTEGER, PARAMETER ::   jpicpd_hpg =  1   !: hydrostatic pressure gradient  
     49   INTEGER, PARAMETER ::   jpicpd_keg =  2   !: kinetic energy gradient 
     50   INTEGER, PARAMETER ::   jpicpd_rvo =  3   !: relative vorticity 
     51   INTEGER, PARAMETER ::   jpicpd_pvo =  4   !: planetary vorticity 
     52   INTEGER, PARAMETER ::   jpicpd_ldf =  5   !: lateral diffusion 
     53   INTEGER, PARAMETER ::   jpicpd_had =  6   !: horizontal advection 
     54   INTEGER, PARAMETER ::   jpicpd_zad =  7   !: vertical advection 
     55   INTEGER, PARAMETER ::   jpicpd_zdf =  8   !: vertical diffusion 
     56   INTEGER, PARAMETER ::   jpicpd_spg =  9   !: surface pressure gradient 
     57   INTEGER, PARAMETER ::   jpicpd_dat = 10   !: damping term 
     58   INTEGER, PARAMETER ::   jpicpd_swf = 11   !: surface wind forcing 
     59   INTEGER, PARAMETER ::   jpicpd_bfr = 12   !: bottom friction  
    6560 
    66    INTEGER, PARAMETER ::   &  !: => Total dynamic trends indexes <= 
    67         jptot_dyn = 12        !: change it when adding/removing one indice above 
     61   !                                        !!! => Total dynamic trends indexes <= 
     62   INTEGER, PARAMETER ::   jptot_dyn  = 12   !: change it when adding/removing one indice above 
    6863    
    6964#if   defined key_trdtra   ||   defined key_trddyn   ||   defined key_esopa 
    … …  
    8984#endif 
    9085   !!---------------------------------------------------------------------- 
    91    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     86   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    9287   !! $Id$  
    9388   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 

  • trunk/NEMO/OPA_SRC/TRD/trdmld.F90

    r1581 r1601  
    7575      !!      The control surface can be either a mixed layer depth (time varying) 
    7676      !!      or a fixed surface (jk level or bowl).  
    77       !!      Choose control surface with nctls in namelist NAMTRD : 
    78       !!        nctls = 0  : use mixed layer with density criterion  
    79       !!        nctls = 1  : read index from file 'ctlsurf_idx' 
    80       !!        nctls > 1  : use fixed level surface jk = nctls 
     77      !!      Choose control surface with nn_ctls in namelist NAMTRD : 
     78      !!        nn_ctls = 0  : use mixed layer with density criterion  
     79      !!        nn_ctls = 1  : read index from file 'ctlsurf_idx' 
     80      !!        nn_ctls > 1  : use fixed level surface jk = nn_ctls 
    8181      !!      Note: in the remainder of the routine, the volume between the  
    8282      !!            surface and the control surface is called "mixed-layer" 
    … …  
    100100          
    101101         ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
    102          IF( nctls == 0 ) THEN       ! * control surface = mixed-layer with density criterion  
     102         IF( nn_ctls == 0 ) THEN       ! * control surface = mixed-layer with density criterion  
    103103            nmld(:,:) = nmln(:,:)    ! array nmln computed in zdfmxl.F90 
    104          ELSE IF( nctls == 1 ) THEN  ! * control surface = read index from file  
     104         ELSE IF( nn_ctls == 1 ) THEN  ! * control surface = read index from file  
    105105            nmld(:,:) = nbol(:,:) 
    106          ELSE IF( nctls >= 2 ) THEN  ! * control surface = model level 
    107             nctls = MIN( nctls, jpktrd - 1 ) 
    108             nmld(:,:) = nctls + 1 
     106         ELSE IF( nn_ctls >= 2 ) THEN  ! * control surface = model level 
     107            nn_ctls = MIN( nn_ctls, jpktrd - 1 ) 
     108            nmld(:,:) = nn_ctls + 1 
    109109         ENDIF 
    110110 
    … …  
    193193      !!          1) to explain the difference between initial and final  
    194194      !!             mixed-layer T & S (where initial and final relate to the 
    195       !!             current analysis window, defined by ntrd in the namelist) 
     195      !!             current analysis window, defined by nn_trd in the namelist) 
    196196      !!          2) to explain the difference between the current and previous  
    197197      !!             TIME-AVERAGED mixed-layer T & S (where time-averaging is 
    … …  
    199199      !! 
    200200      !! ** Consistency check :  
    201       !!        If the control surface is fixed ( nctls > 1 ), the residual term (dh/dt 
     201      !!        If the control surface is fixed ( nn_ctls > 1 ), the residual term (dh/dt 
    202202      !!        entrainment) should be zero, at machine accuracy. Note that in the case 
    203203      !!        of time-averaged mixed-layer fields, this residual WILL NOT BE ZERO 
    204204      !!        over the first two analysis windows (except if restart). 
    205       !!        N.B. For ORCA2_LIM, use e.g. ntrd=5, ucf=1., nctls=8 
     205      !!        N.B. For ORCA2_LIM, use e.g. nn_trd=5, rn_ucf=1., nn_ctls=8 
    206206      !!             for checking residuals. 
    207207      !!             On a NEC-SX5 computer, this typically leads to: 
    … …  
    351351      ! 
    352352      !     o---[--o-----o-----o-----o--]-[--o-----o-----o-----o-----o--]---o-----o--> time steps 
    353       !                            ntrd                             2*ntrd       etc. 
     353      !                          nn_trd                           2*nn_trd       etc. 
    354354      !     1      2     3     4    =5 e.g.                          =10 
    355355      ! 
    … …  
    386386      ! N.B. It may be useful to check IOIPSL time averaging with : 
    387387      !      tmltrd (:,:,:) = 1. ; smltrd (:,:,:) = 1. 
    388       tmltrd(:,:,:) = tmltrd(:,:,:) * ucf   ! (actually needed for 1:jpltrd-1, but trdmld(:,:,jpltrd) 
    389       smltrd(:,:,:) = smltrd(:,:,:) * ucf   !  is no longer used, and is reset to 0. at next time step) 
     388      tmltrd(:,:,:) = tmltrd(:,:,:) * rn_ucf   ! (actually needed for 1:jpltrd-1, but trdmld(:,:,jpltrd) 
     389      smltrd(:,:,:) = smltrd(:,:,:) * rn_ucf   !  is no longer used, and is reset to 0. at next time step) 
    390390       
    391391      ! define time axis 
    … …  
    393393      itmod = kt - nit000 + 1 
    394394 
    395       MODULO_NTRD : IF( MOD( itmod, ntrd ) == 0 ) THEN        ! nitend MUST be multiple of ntrd 
     395      MODULO_NTRD : IF( MOD( itmod, nn_trd ) == 0 ) THEN        ! nitend MUST be multiple of nn_trd 
    396396         ! 
    397397         ztmltot (:,:) = 0.e0   ;   zsmltot (:,:) = 0.e0   ! reset arrays to zero 
    … …  
    519519 
    520520         !    ... temperature ...                         ... salinity ... 
    521          ztmltot (:,:)   = ztmltot(:,:)   * ucf/zfn  ; zsmltot (:,:)   = zsmltot(:,:)   * ucf/zfn 
    522          ztmlres (:,:)   = ztmlres(:,:)   * ucf/zfn  ; zsmlres (:,:)   = zsmlres(:,:)   * ucf/zfn 
    523          ztmlatf (:,:)   = ztmlatf(:,:)   * ucf/zfn  ; zsmlatf (:,:)   = zsmlatf(:,:)   * ucf/zfn 
     521         ztmltot (:,:)   = ztmltot(:,:)   * rn_ucf/zfn  ; zsmltot (:,:)   = zsmltot(:,:)   * rn_ucf/zfn 
     522         ztmlres (:,:)   = ztmlres(:,:)   * rn_ucf/zfn  ; zsmlres (:,:)   = zsmlres(:,:)   * rn_ucf/zfn 
     523         ztmlatf (:,:)   = ztmlatf(:,:)   * rn_ucf/zfn  ; zsmlatf (:,:)   = zsmlatf(:,:)   * rn_ucf/zfn 
    524524 
    525525         tml_sum (:,:)   = tml_sum (:,:)  /  (2*zfn) ; sml_sum (:,:)   = sml_sum (:,:)  /  (2*zfn) 
    526          ztmltot2(:,:)   = ztmltot2(:,:)  * ucf/zfn2 ; zsmltot2(:,:)   = zsmltot2(:,:)  * ucf/zfn2 
    527          ztmltrd2(:,:,:) = ztmltrd2(:,:,:)* ucf/zfn2 ; zsmltrd2(:,:,:) = zsmltrd2(:,:,:)* ucf/zfn2 
    528          ztmlatf2(:,:)   = ztmlatf2(:,:)  * ucf/zfn2 ; zsmlatf2(:,:)   = zsmlatf2(:,:)  * ucf/zfn2 
    529          ztmlres2(:,:)   = ztmlres2(:,:)  * ucf/zfn2 ; zsmlres2(:,:)   = zsmlres2(:,:)  * ucf/zfn2 
     526         ztmltot2(:,:)   = ztmltot2(:,:)  * rn_ucf/zfn2 ; zsmltot2(:,:)   = zsmltot2(:,:)  * rn_ucf/zfn2 
     527         ztmltrd2(:,:,:) = ztmltrd2(:,:,:)* rn_ucf/zfn2 ; zsmltrd2(:,:,:) = zsmltrd2(:,:,:)* rn_ucf/zfn2 
     528         ztmlatf2(:,:)   = ztmlatf2(:,:)  * rn_ucf/zfn2 ; zsmlatf2(:,:)   = zsmlatf2(:,:)  * rn_ucf/zfn2 
     529         ztmlres2(:,:)   = ztmlres2(:,:)  * rn_ucf/zfn2 ; zsmlres2(:,:)   = zsmlres2(:,:)  * rn_ucf/zfn2 
    530530 
    531531         rmld_sum(:,:)   = rmld_sum(:,:)  /  (2*zfn)  ! similar to tml_sum and sml_sum 
    … …  
    578578#if defined key_dimgout 
    579579 
    580       IF( MOD( itmod, ntrd ) == 0 ) THEN 
     580      IF( MOD( itmod, nn_trd ) == 0 ) THEN 
    581581         iyear =  ndastp/10000 
    582582         imon  = (ndastp-iyear*10000)/100 
    583583         iday  =  ndastp - imon*100 - iyear*10000 
    584584         WRITE(clname,9000) TRIM(cexper),'MLDiags',iyear,imon,iday 
    585          WRITE(clmode,'(f5.1,a)') ntrd*rdt/86400.,' days average' 
     585         WRITE(clmode,'(f5.1,a)') nn_trd*rdt/86400.,' days average' 
    586586         cltext = TRIM(cexper)//' mld diags'//TRIM(clmode) 
    587587         CALL dia_wri_dimg (clname, cltext, smltrd, jpltrd, '2') 
    … …  
    595595      ! ---------------------------------- 
    596596 
    597       IF( lwp .AND. MOD( itmod , ntrd ) == 0 ) THEN 
     597      IF( lwp .AND. MOD( itmod , nn_trd ) == 0 ) THEN 
    598598         WRITE(numout,*) ' ' 
    599599         WRITE(numout,*) 'trd_mld : write trends in the NetCDF file :' 
    … …  
    685685#endif 
    686686 
    687       IF( MOD( itmod, ntrd ) == 0 ) THEN 
     687      IF( MOD( itmod, nn_trd ) == 0 ) THEN 
    688688         ! 
    689689         ! III.5 Reset cumulative arrays to zero 
    … …  
    744744      ! ------------------------------------------------- 
    745745 
    746       IF( ( lk_trdmld ) .AND. ( MOD( nitend, ntrd ) /= 0 ) ) THEN 
     746      IF( ( lk_trdmld ) .AND. ( MOD( nitend, nn_trd ) /= 0 ) ) THEN 
    747747         WRITE(numout,cform_err) 
    748748         WRITE(numout,*) '                Your nitend parameter, nitend = ', nitend 
    749749         WRITE(numout,*) '                is no multiple of the trends diagnostics frequency        ' 
    750          WRITE(numout,*) '                          you defined, ntrd   = ', ntrd 
     750         WRITE(numout,*) '                          you defined, nn_trd   = ', nn_trd 
    751751         WRITE(numout,*) '                This will not allow you to restart from this simulation.  ' 
    752752         WRITE(numout,*) '                You should reconsider this choice.                        '  
    … …  
    797797      ! ---------------------------------------------- 
    798798  
    799       IF( nctls == 1 ) THEN 
     799      IF( nn_ctls == 1 ) THEN 
    800800         CALL ctl_opn( numbol, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 
    801801         READ ( numbol ) nbol 
    … …  
    811811#else 
    812812      ! clmxl = legend root for netCDF output 
    813       IF( nctls == 0 ) THEN      ! control surface = mixed-layer with density criterion 
     813      IF( nn_ctls == 0 ) THEN      ! control surface = mixed-layer with density criterion 
    814814         clmxl = 'Mixed Layer '  !                   (array nmln computed in zdfmxl.F90) 
    815       ELSE IF( nctls == 1 ) THEN ! control surface = read index from file  
     815      ELSE IF( nn_ctls == 1 ) THEN ! control surface = read index from file  
    816816         clmxl = '      Bowl ' 
    817       ELSE IF( nctls >= 2 ) THEN ! control surface = model level 
    818          WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nctls 
     817      ELSE IF( nn_ctls >= 2 ) THEN ! control surface = model level 
     818         WRITE(clmxl,'(A10,I2,1X)') 'Levels 1 -', nn_ctls 
    819819      END IF 
    820820 
    … …  
    828828         CALL ctl_stop( 'trd_mld : this was never checked. Comment this line to proceed...' ) 
    829829      END IF 
    830       zsto = ntrd * rdt 
     830      zsto = nn_trd * rdt 
    831831      clop = "inst("//TRIM(clop)//")" 
    832832#  else 
    … …  
    834834         zsto = rdt                 ! inst. diags : we use IOIPSL time averaging 
    835835      ELSE 
    836          zsto = ntrd * rdt          ! mean  diags : we DO NOT use any IOIPSL time averaging 
     836         zsto = nn_trd * rdt          ! mean  diags : we DO NOT use any IOIPSL time averaging 
    837837      END IF 
    838838      clop = "ave("//TRIM(clop)//")" 
    839839#  endif 
    840       zout = ntrd * rdt 
     840      zout = nn_trd * rdt 
    841841 
    842842      IF(lwp) WRITE (numout,*) '                netCDF initialization' 
    … …  
    870870                                                                   
    871871      !-- Create a NetCDF file and enter the define mode  
    872       CALL dia_nam( clhstnam, ntrd, 'trends' ) 
     872      CALL dia_nam( clhstnam, nn_trd, 'trends' ) 
    873873      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 
    874874      CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    … …  
    880880 
    881881      !-- Define physical units 
    882       IF( ucf == 1. ) THEN 
    883          cltu = "degC/s"     ;   clsu = "p.s.u./s" 
    884       ELSEIF ( ucf == 3600.*24.) THEN 
    885          cltu = "degC/day"   ;   clsu = "p.s.u./day" 
    886       ELSE 
    887          cltu = "unknown?"   ;   clsu = "unknown?" 
    888       END IF 
     882      IF     ( rn_ucf == 1.       ) THEN   ;   cltu = "degC/s"     ;   clsu = "p.s.u./s" 
     883      ELSEIF ( rn_ucf == 3600.*24.) THEN   ;   cltu = "degC/day"   ;   clsu = "p.s.u./day" 
     884      ELSE                                 ;   cltu = "unknown?"   ;   clsu = "unknown?" 
     885      END IF 
     886 
    889887 
    890888      !-- Define miscellaneous T and S mixed-layer variables  

  • trunk/NEMO/OPA_SRC/TRD/trdmod.F90

    r1229 r1601  
    8080      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    8181 
    82       IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) )   THEN 
     82      IF( ( mod(kt,nn_trd) == 0 .OR. kt == nit000 .OR. kt == nitend) )   THEN 
    8383         ! 
    8484         IF( lk_trdtra .AND. ctype == 'TRA' )   THEN       ! active tracer trends 
    … …  
    281281      USE in_out_manager          ! I/O manager 
    282282 
    283       NAMELIST/namtrd/ ntrd, nctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, ucf, ln_trdmld_instant 
     283      NAMELIST/namtrd/ nn_trd, nn_ctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, rn_ucf, ln_trdmld_instant 
    284284      !!---------------------------------------------------------------------- 
    285285 
    … …  
    292292            WRITE(numout,*) ' trd_mod_init : Momentum/Tracers trends' 
    293293            WRITE(numout,*) ' ~~~~~~~~~~~~~' 
    294             WRITE(numout,*) '       Namelist namtrd : set trends parameters' 
    295             WRITE(numout,*) '           * frequency of trends diagnostics   ntrd               = ', ntrd 
    296             WRITE(numout,*) '           * control surface type              nctls              = ', nctls 
    297             WRITE(numout,*) '           * restart for ML diagnostics        ln_trdmld_restart  = ', ln_trdmld_restart 
    298             WRITE(numout,*) '           * instantaneous or mean ML T/S      ln_trdmld_instant  = ', ln_trdmld_instant 
    299             WRITE(numout,*) '           * unit conversion factor            ucf                = ', ucf 
     294            WRITE(numout,*) '   Namelist namtrd : set trends parameters' 
     295            WRITE(numout,*) '      frequency of trends diagnostics   nn_trd             = ', nn_trd 
     296            WRITE(numout,*) '      control surface type              nn_ctls            = ', nn_ctls 
     297            WRITE(numout,*) '      restart for ML diagnostics        ln_trdmld_restart  = ', ln_trdmld_restart 
     298            WRITE(numout,*) '      instantaneous or mean ML T/S      ln_trdmld_instant  = ', ln_trdmld_instant 
     299            WRITE(numout,*) '      unit conversion factor            rn_ucf             = ', rn_ucf 
    300300        ENDIF 
    301301      ENDIF 

  • trunk/NEMO/OPA_SRC/TRD/trdmod_oce.F90

    r1229 r1601  
    1313   PUBLIC 
    1414 
    15    !!* Namelist namtrd:  diagnostics on dynamics/tracer trends 
    16    INTEGER , PUBLIC  ::   ntrd  = 10                      !: time step frequency dynamics and tracers trends 
    17    INTEGER , PUBLIC  ::   nctls =  0                      !: control surface type for trends vertical integration 
    18    REAL(wp), PUBLIC  ::   ucf   = 1.                      !: unit conversion factor (for netCDF trends outputs) 
     15   !                                                     !!* Namelist namtrd:  diagnostics on dynamics/tracer trends * 
     16   INTEGER , PUBLIC  ::   nn_trd  = 10                    !: time step frequency dynamics and tracers trends 
     17   INTEGER , PUBLIC  ::   nn_ctls =  0                    !: control surface type for trends vertical integration 
     18   REAL(wp), PUBLIC  ::   rn_ucf   = 1.                   !: unit conversion factor (for netCDF trends outputs) 
    1919                                                          !: =1. (=86400.) for degC/s (degC/day) and psu/s (psu/day) 
    2020   CHARACTER(len=32) ::   cn_trdrst_in  = "restart_mld"   !: suffix of ocean restart name (input) 
    … …  
    2323   LOGICAL , PUBLIC  ::   ln_trdmld_restart = .FALSE.     !: flag to restart mixed-layer diagnostics 
    2424 
    25    !!* Control parameters 
    2625# if defined key_trdtra   ||   defined key_trdmld 
    2726   LOGICAL , PUBLIC ::   l_trdtra = .TRUE.              !: tracers  trend flag 
    … …  
    3534# endif 
    3635 
    37    !!* Active tracers trends indexes 
     36   !                                                   !!! Active tracers trends indexes 
    3837   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_xad =  1   !: x- horizontal advection 
    3938   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_yad =  2   !: y- horizontal advection 
    … …  
    4948   INTEGER, PUBLIC, PARAMETER ::   jptra_trd_atf = 12   !: Asselin correction 
    5049    
    51    !!* Momentum trends indexes 
     50   !                                                   !!! Momentum trends indexes 
    5251   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_hpg =  1   !: hydrostatic pressure gradient  
    5352   INTEGER, PUBLIC, PARAMETER ::   jpdyn_trd_keg =  2   !: kinetic energy gradient 
    … …  
    6463 
    6564   !!---------------------------------------------------------------------- 
    66    !!  OPA 9.0 , LOCEAN-IPSL (2006)  
     65   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    6766   !! $Id$  
    6867   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 

  • trunk/NEMO/OPA_SRC/TRD/trdvor.F90

    r1334 r1601  
    409409      itmod = kt - nit000 + 1 
    410410 
    411       IF( MOD( it, ntrd ) == 0 ) THEN 
     411      IF( MOD( it, nn_trd ) == 0 ) THEN 
    412412 
    413413         ! III.1 compute total trend 
    … …  
    456456      IF( kt >=  nit000+1 ) THEN 
    457457 
    458          IF( lwp .AND. MOD( itmod, ntrd ) == 0 ) THEN 
     458         IF( lwp .AND. MOD( itmod, nn_trd ) == 0 ) THEN 
    459459            WRITE(numout,*) '' 
    460460            WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt 
    … …  
    483483      ENDIF 
    484484      ! 
    485       IF( MOD( it, ntrd ) == 0 ) rotot(:,:)=0 
     485      IF( MOD( it, nn_trd ) == 0 ) rotot(:,:)=0 
    486486      ! 
    487487      IF( kt == nitend )   CALL histclo( nidvor ) 
    … …  
    551551      clop = "ave("//TRIM(clop)//")" 
    552552#endif 
    553       zout = ntrd*rdt 
     553      zout = nn_trd*rdt 
    554554 
    555555      IF(lwp) WRITE(numout,*) '               netCDF initialization' 
    … …  
    566566      ! II.3 Define the T grid trend file (nidvor) 
    567567      ! --------------------------------- 
    568       CALL dia_nam( clhstnam, ntrd, 'vort' )                  ! filename 
     568      CALL dia_nam( clhstnam, nn_trd, 'vort' )                  ! filename 
    569569      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 
    570570      CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi,   &  ! Horizontal grid : glamt and gphit 

  • trunk/NEMO/OPA_SRC/ZDF/zdf_oce.F90

    r1546 r1601  
    1818#endif 
    1919 
    20    !                                           !!* namelist nam_zdf: vertical diffusion * 
     20   !                                           !!* namelist namzdf: vertical diffusion * 
    2121   REAL(wp), PUBLIC ::   rn_avm0   = 1.e-4_wp   !: vertical eddy viscosity (m2/s) 
    2222   REAL(wp), PUBLIC ::   rn_avt0   = 1.e-5_wp   !: vertical eddy diffusivity (m2/s) 

  • trunk/NEMO/OPA_SRC/ZDF/zdfbfr.F90

    r1152 r1601  
    44   !! Ocean physics: Bottom friction 
    55   !!====================================================================== 
     6   !! History :  8.0  ! 1997-06  (G. Madec, A.-M. Treguier)  Original code 
     7   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     8   !!---------------------------------------------------------------------- 
    69 
    710   !!---------------------------------------------------------------------- 
    8    !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the 
    9    !!                  type of bottom friction chosen 
    10    !!   zdf_bfr_init : read in namelist and control the bottom friction 
    11    !!                  parameters. 
     11   !!   zdf_bfr      : update momentum Kz at the ocean bottom due to the type of bottom friction chosen 
     12   !!   zdf_bfr_init : read in namelist and control the bottom friction parameters. 
    1213   !!---------------------------------------------------------------------- 
    13    !! * Modules used 
    1414   USE oce             ! ocean dynamics and tracers variables 
    1515   USE dom_oce         ! ocean space and time domain variables  
    … …  
    2222   PRIVATE 
    2323 
    24    !! * Routine accessibility 
    25    PUBLIC zdf_bfr    ! called by step.F90 
     24   PUBLIC   zdf_bfr    ! called by step.F90 
    2625 
    27    !! * Module variables 
    28    INTEGER ::             & !!! ** bottom friction namelist (nambfr) ** 
    29       nbotfr = 0             ! = 0/1/2/3 type of bottom friction  
    30    REAL(wp) ::            & !!! ** bottom friction namelist (nambfr) ** 
    31       bfri1 = 4.0e-4_wp,  &  ! bottom drag coefficient (linear case)  
    32       bfri2 = 1.0e-3_wp,  &  ! bottom drag coefficient (non linear case) 
    33       bfeb2 = 2.5e-3_wp      ! background bottom turbulent kinetic energy  (m2/s2) 
     26   !                                   !!* Namelist nambfr: bottom friction namelist * 
     27   INTEGER  ::   nn_bfr   = 0           ! = 0/1/2/3 type of bottom friction  
     28   REAL(wp) ::   rn_bfri1 = 4.0e-4_wp   ! bottom drag coefficient (linear case)  
     29   REAL(wp) ::   rn_bfri2 = 1.0e-3_wp   ! bottom drag coefficient (non linear case) 
     30   REAL(wp) ::   rn_bfeb2 = 2.5e-3_wp   ! background bottom turbulent kinetic energy  [m2/s2] 
    3431 
    3532   !! * Substitutions 
    3633#  include "domzgr_substitute.h90" 
    3734   !!---------------------------------------------------------------------- 
    38    !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     35   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    3936   !! $Id$  
    40    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     37   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    4138   !!---------------------------------------------------------------------- 
    4239 
    … …  
    4845      !!                  
    4946      !! ** Purpose :   Applied the bottom friction through a specification of  
    50       !!      Kz at the ocean bottom. 
     47      !!              Kz at the ocean bottom. 
    5148      !! 
    5249      !! ** Method  :   Update the value of avmu and avmv at the ocean bottom  
    5350      !!       level following the chosen friction type (no-slip, free-slip,  
    5451      !!       linear, or quadratic) 
     52      !!---------------------------------------------------------------------- 
     53      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5554      !! 
    56       !! History : 
    57       !!   8.0  !  97-06  (G. Madec, A.-M. Treguier)  Original code 
    58       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
     55      INTEGER  ::   ji, jj   ! dummy loop indexes 
     56      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1   ! temporary integers 
     57      REAL(wp) ::   zvu, zuv, zecu, zecv         ! temporary scalars 
    5958      !!---------------------------------------------------------------------- 
    60       !! * Arguments 
    61       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    62  
    63       !! * Local declarations 
    64       INTEGER ::   & 
    65          ji, jj,                   &  ! dummy loop indexes 
    66          ikbu, ikbv,               &  ! temporary integers 
    67          ikbum1, ikbvm1               ! 
    68       REAL(wp) ::   & 
    69          zvu, zuv, zecu, zecv         ! temporary scalars 
    70       !!---------------------------------------------------------------------- 
    71  
    7259 
    7360      IF( kt == nit000 )   CALL zdf_bfr_init 
    7461 
    75  
    76       ! Compute avmu, avmv at the ocean bottom 
    77       ! -------------------------------------- 
    78  
    79       SELECT CASE (nbotfr) 
    80  
    81       CASE( 0 )                 ! no-slip boundary condition 
     62      !                               ! -------------------------------------- 
     63      SELECT CASE (nn_bfr)            ! Compute avmu, avmv at the ocean bottom 
     64      !                               ! -------------------------------------- 
     65      ! 
     66      CASE( 0 )                            !==  no-slip boundary condition  ==! 
    8267# if defined key_vectopt_loop 
    83          jj = 1 
    84          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     68         DO jj = 1, 1 
     69            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    8570# else 
    8671         DO jj = 2, jpjm1 
    … …  
    9378               avmu(ji,jj,ikbu) = 2. * avmu(ji,jj,ikbum1) 
    9479               avmv(ji,jj,ikbv) = 2. * avmv(ji,jj,ikbvm1) 
    95 # if ! defined key_vectopt_loop 
    9680            END DO 
    97 # endif 
    9881         END DO 
    9982 
    100       CASE( 1 )                 ! linear botton friction 
     83      CASE( 1 )                            !==  linear botton friction  ==! 
    10184# if defined key_vectopt_loop 
    102          jj = 1 
    103          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     85         DO jj = 1, 1 
     86            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    10487# else 
    10588         DO jj = 2, jpjm1 
    … …  
    10891               ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) ) 
    10992               ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) ) 
    110                avmu(ji,jj,ikbu) = bfri1 * fse3uw(ji,jj,ikbu) 
    111                avmv(ji,jj,ikbv) = bfri1 * fse3vw(ji,jj,ikbv) 
    112 # if ! defined key_vectopt_loop 
     93               avmu(ji,jj,ikbu) = rn_bfri1 * fse3uw(ji,jj,ikbu) 
     94               avmv(ji,jj,ikbv) = rn_bfri1 * fse3vw(ji,jj,ikbv) 
    11395            END DO 
    114 # endif 
    11596         END DO 
    11697 
    117       CASE( 2 )                 ! quadratic botton friction 
     98      CASE( 2 )                            !==  quadratic botton friction  ==! 
    11899# if defined key_vectopt_loop 
    119          jj = 1 
     100         DO jj = 1, 1 
    120101!CDIR NOVERRCHK 
    121          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     102            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    122103# else 
    123104!CDIR NOVERRCHK 
    … …  
    137118                              + un(ji,jj+1,ikbvm1) + un(ji-1,jj+1,ikbvm1)  ) 
    138119                
    139                zecu = SQRT(  un(ji,jj,ikbum1) * un(ji,jj,ikbum1) + zvu*zvu + bfeb2  ) 
    140                zecv = SQRT(  vn(ji,jj,ikbvm1) * vn(ji,jj,ikbvm1) + zuv*zuv + bfeb2  ) 
     120               zecu = SQRT(  un(ji,jj,ikbum1) * un(ji,jj,ikbum1) + zvu*zvu + rn_bfeb2  ) 
     121               zecv = SQRT(  vn(ji,jj,ikbvm1) * vn(ji,jj,ikbvm1) + zuv*zuv + rn_bfeb2  ) 
    141122                
    142                avmu(ji,jj,ikbu) = bfri2 * zecu * fse3uw(ji,jj,ikbu) 
    143                avmv(ji,jj,ikbv) = bfri2 * zecv * fse3vw(ji,jj,ikbv) 
    144 # if ! defined key_vectopt_loop 
     123               avmu(ji,jj,ikbu) = rn_bfri2 * zecu * fse3uw(ji,jj,ikbu) 
     124               avmv(ji,jj,ikbv) = rn_bfri2 * zecv * fse3vw(ji,jj,ikbv) 
    145125            END DO 
    146 # endif 
    147126         END DO 
    148127 
    149       CASE( 3 )                 ! free-slip boundary condition 
     128      CASE( 3 )                            !==  free-slip boundary condition  ==! 
    150129# if defined key_vectopt_loop 
    151          jj = 1 
    152          DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     130         DO jj = 1, 1 
     131            DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    153132# else 
    154133         DO jj = 2, jpjm1 
    … …  
    159138               avmu(ji,jj,ikbu) = 0.e0 
    160139               avmv(ji,jj,ikbv) = 0.e0 
    161 # if ! defined key_vectopt_loop 
    162140            END DO 
    163 # endif 
    164141         END DO 
     142         ! 
     143      END SELECT 
     144      CALL lbc_lnk( avmu, 'U', 1. )   ;    CALL lbc_lnk( avmv, 'V', 1. )   ! Lateral boundary condition   (unchanged sign) 
    165145 
    166       END SELECT 
    167  
    168       ! Lateral boundary condition on (avmu,avmv)   (unchanged sign) 
    169       ! ------------------------------=========== 
    170       CALL lbc_lnk( avmu, 'U', 1. ) 
    171       CALL lbc_lnk( avmv, 'V', 1. ) 
    172  
    173       IF(ln_ctl)  THEN 
    174          CALL prt_ctl(tab3d_1=avmu, clinfo1=' bfr  - u: ', mask1=umask, & 
    175             &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask,ovlap=1, kdim=jpk) 
    176       ENDIF 
    177  
     146      IF(ln_ctl)   CALL prt_ctl( tab3d_1=avmu, clinfo1=' bfr  - u: ', mask1=umask,             & 
     147         &                       tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask,ovlap=1, kdim=jpk ) 
     148      ! 
    178149   END SUBROUTINE zdf_bfr 
    179150 
    … …  
    186157      !! 
    187158      !! ** Method  :   Read the nammbf namelist and check their consistency 
    188       !!      called at the first timestep (nit000) 
    189       !! 
    190       !! History : 
    191       !!   9.0  !  02-06  (G. Madec)  Original code 
    192159      !!---------------------------------------------------------------------- 
    193       !! * Local declarations 
    194       NAMELIST/nambfr/ nbotfr, bfri1, bfri2, bfeb2 
     160      NAMELIST/nambfr/ nn_bfr, rn_bfri1, rn_bfri2, rn_bfeb2 
    195161      !!---------------------------------------------------------------------- 
    196162 
    197       ! Read Namelist nambfr : bottom momentum boundary condition 
    198       ! -------------------- 
    199       REWIND ( numnam ) 
    200       READ   ( numnam, nambfr ) 
     163      REWIND( numnam )              ! Read Namelist nambfr : bottom momentum boundary condition 
     164      READ  ( numnam, nambfr ) 
    201165 
    202  
    203       ! Parameter control and print 
    204       ! --------------------------- 
    205       IF(lwp) WRITE(numout,*) 
     166      IF(lwp) WRITE(numout,*)       ! Parameter print 
    206167      IF(lwp) WRITE(numout,*) 'zdf_bfr : momentum bottom friction' 
    207168      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    208       IF(lwp) WRITE(numout,*) '          Namelist nambfr : set bottom friction parameters' 
     169      IF(lwp) WRITE(numout,*) '   Namelist nambfr : set bottom friction parameters' 
    209170 
    210       SELECT CASE (nbotfr) 
    211  
     171      SELECT CASE (nn_bfr)          ! Parameter control 
     172      ! 
    212173      CASE( 0 ) 
    213          IF(lwp) WRITE(numout,*) '            no-slip ' 
    214  
     174         IF(lwp) WRITE(numout,*) '      no-slip ' 
     175         ! 
    215176      CASE( 1 ) 
    216          IF(lwp) WRITE(numout,*) '            linear botton friction' 
    217          IF(lwp) WRITE(numout,*) '            friction coef.   bfri1  = ', bfri1 
    218  
     177         IF(lwp) WRITE(numout,*) '      linear botton friction      nn_bfr    = ', nn_bfr 
     178         IF(lwp) WRITE(numout,*) '      friction coef.              rn_bfri1  = ', rn_bfri1 
     179         ! 
    219180      CASE( 2 ) 
    220          IF(lwp) WRITE(numout,*) '            quadratic botton friction' 
    221          IF(lwp) WRITE(numout,*) '            friction coef.   bfri2  = ', bfri2 
    222          IF(lwp) WRITE(numout,*) '            background tke   bfeb2  = ', bfeb2 
    223  
     181         IF(lwp) WRITE(numout,*) '      quadratic botton friction   nn_bfr    = ', nn_bfr 
     182         IF(lwp) WRITE(numout,*) '      friction coef.              rn_bfri2  = ', rn_bfri2 
     183         IF(lwp) WRITE(numout,*) '      background KE               rn_bfeb2  = ', rn_bfeb2 
     184         ! 
    224185      CASE( 3 ) 
    225          IF(lwp) WRITE(numout,*) '            free-slip ' 
    226  
     186         IF(lwp) WRITE(numout,*) '      free-slip ' 
     187         ! 
    227188      CASE DEFAULT 
    228          WRITE(ctmp1,*) '         bad flag value for nbotfr = ', nbotfr 
     189         WRITE(ctmp1,*) 'bad flag value for nn_bfr = ', nn_bfr 
    229190         CALL ctl_stop( ctmp1 ) 
    230  
     191         ! 
    231192      END SELECT 
    232  
     193      ! 
    233194   END SUBROUTINE zdf_bfr_init 
    234195 

  • trunk/NEMO/OPA_SRC/ZDF/zdfddm.F90

    r1537 r1601  
    44   !! Ocean physics : double diffusion mixing parameterization 
    55   !!====================================================================== 
     6   !! History :  OPA  ! 2000-08  (G. Madec)  double diffusive mixing 
     7   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     8   !!---------------------------------------------------------------------- 
    69#if defined key_zdfddm   ||   defined key_esopa 
    710   !!---------------------------------------------------------------------- 
    … …  
    2831   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   rrau   !: heat/salt buoyancy flux ratio 
    2932 
    30    !                                  !!* Namelist nam_ddm : double diffusive mixing * 
     33   !                                  !!* Namelist namzdf_ddm : double diffusive mixing * 
    3134   REAL(wp) ::   rn_avts  = 1.e-4_wp   ! maximum value of avs for salt fingering 
    3235   REAL(wp) ::   rn_hsbfr = 1.6_wp     ! heat/salt buoyancy flux ratio 
    … …  
    4750      !!                     
    4851      !! ** Purpose :   Add to the vertical eddy diffusivity coefficient the  
    49       !!      effect of salt fingering and diffusive convection.  
     52      !!              effect of salt fingering and diffusive convection.  
    5053      !! 
    5154      !! ** Method  :   Diapycnal mixing is increased in case of double 
    … …  
    7073      !!      avmu, avmv are required to remain at least above avt and avs. 
    7174      !!       
    72       !! ** Action  :   avt, avs : update vertical eddy diffusivity coef. 
    73       !!                           for temperature and salinity 
    74       !! 
    75       !! References : 
    76       !!      Merryfield et al., JPO, 29, 1124-1142, 1999. 
    77       !! History : 
    78       !!        !  00-08  (G. Madec)  double diffusive mixing 
    79       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
    80       !!---------------------------------------------------------------------- 
    81       !! * Arguments 
    82       INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step 
    83  
    84       !! * Local declarations 
    85       INTEGER ::   ji, jj , jk              ! dummy loop indices 
    86       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    87          zmsks, zmskf,                    & ! temporary workspace  
    88          zmskd1, zmskd2, zmskd3             !    "           " 
    89       REAL(wp) ::   & 
    90          zinr, zrr,                       & ! temporary scalars 
    91          zavft, zavfs,                    & !    "         " 
    92          zavdt, zavds                       !    "         " 
    93       !!---------------------------------------------------------------------- 
    94  
     75      !! ** Action  :   avt, avs : updated vertical eddy diffusivity coef. for T & S 
     76      !! 
     77      !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999. 
     78      !!---------------------------------------------------------------------- 
     79      INTEGER, INTENT(in) ::   kt   ! ocean time-step indexocean time step 
     80      !! 
     81      INTEGER  ::   ji, jj , jk     ! dummy loop indices 
     82      REAL(wp) ::   zinr, zrr       ! temporary scalars 
     83      REAL(wp) ::   zavft, zavfs    !    -         - 
     84      REAL(wp) ::   zavdt, zavds    !    -         - 
     85      REAL(wp), DIMENSION(jpi,jpj) ::   zmsks, zmskf, zmskd1, zmskd2, zmskd3   ! 2D workspace  
     86      !!---------------------------------------------------------------------- 
    9587 
    9688      IF ( kt == nit000 )   CALL zdf_ddm_init          ! Initialization (first time-step only) 
    9789 
    98  
    99       ! Compute avs 
    100       ! ----------- 
    10190      !                                                ! =============== 
    10291      DO jk = 2, jpkm1                                 ! Horizontal slab 
    … …  
    10493         ! Define the mask  
    10594         ! --------------- 
    106          ! only retains positive value of rrau 
    107          rrau(:,:,jk) = MAX( 1.e-20, rrau(:,:,jk) ) 
    108  
    109          ! indicators: 
    110          DO jj = 1, jpj 
     95         rrau(:,:,jk) = MAX( 1.e-20, rrau(:,:,jk) )         ! only retains positive value of rrau 
     96 
     97         DO jj = 1, jpj                                     ! indicators: 
    11198            DO ji = 1, jpi 
    11299               ! stability indicator: msks=1 if rn2>0; 0 elsewhere 
    … …  
    158145               zrr = rrau(ji,jj,jk)/rn_hsbfr 
    159146               zrr = zrr * zrr 
    160                zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) *zmskf(ji,jj) 
     147               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 
    161148               zavft = 0.7 * zavfs * zinr 
    162149               ! diffusive layering 
    163                zavdt = 1.3635e-6 * EXP(4.6*EXP(-0.54*(zinr-1.) ) )   & 
    164                                  * zmsks(ji,jj) * zmskd1(ji,jj) 
    165                zavds = zavdt * zmsks(ji,jj)   & 
    166                      * ( (1.85 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj)   & 
    167                        +  0.15 * rrau(ji,jj,jk)          * zmskd2(ji,jj)  ) 
     150               zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj) 
     151               zavds = zavdt * zmsks(ji,jj) * (  (1.85 * rrau(ji,jj,jk) - 0.85 ) * zmskd3(ji,jj)   & 
     152                  &                            +  0.15 * rrau(ji,jj,jk)          * zmskd2(ji,jj)  ) 
    168153               ! add to the eddy viscosity coef. previously computed 
    169154               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds 
    … …  
    180165            DO ji = 1, fs_jpim1   ! vector opt. 
    181166               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    & 
    182                                      avt(ji,jj,jk), avt(ji+1,jj,jk),   & 
    183                                      avs(ji,jj,jk), avs(ji+1,jj,jk) )   & 
    184                               * umask(ji,jj,jk) 
     167                  &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   & 
     168                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * umask(ji,jj,jk) 
    185169               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    & 
    186                                      avt(ji,jj,jk), avt(ji,jj+1,jk),   & 
    187                                      avs(ji,jj,jk), avs(ji,jj+1,jk) )   & 
    188                               * vmask(ji,jj,jk) 
     170                  &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   & 
     171                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * vmask(ji,jj,jk) 
    189172            END DO 
    190173         END DO 
    … …  
    192175      END DO                                              !   End of slab 
    193176      !                                                   ! =============== 
    194        
    195       ! Lateral boundary conditions on ( avt, avs, avmu, avmv )   (unchanged sign) 
    196       ! -------------------------------======================== 
    197       CALL lbc_lnk( avt , 'W', 1. ) 
     177      ! 
     178      CALL lbc_lnk( avt , 'W', 1. )        ! Lateral boundary conditions   (unchanged sign) 
    198179      CALL lbc_lnk( avs , 'W', 1. ) 
    199180      CALL lbc_lnk( avm , 'W', 1. ) 
    … …  
    206187            &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk) 
    207188      ENDIF 
    208        
     189      ! 
    209190   END SUBROUTINE zdf_ddm 
    210191    
    … …  
    216197      !! ** Purpose :   Initialization of double diffusion mixing scheme 
    217198      !! 
    218       !! ** Method  :   Read the nam_ddm namelist and check the parameter values 
     199      !! ** Method  :   Read the namzdf_ddm namelist and check the parameter values 
    219200      !!              called by zdf_ddm at the first timestep (nit000) 
    220       !! 
    221       !! History :  8.5  !  02-08  (G. Madec)  Original code 
    222       !!---------------------------------------------------------------------- 
    223       NAMELIST/nam_ddm/ rn_avts, rn_hsbfr 
    224       !!---------------------------------------------------------------------- 
    225       ! 
    226       REWIND ( numnam )               ! Read Namelist nam_ddm : double diffusion mixing scheme 
    227       READ   ( numnam, nam_ddm ) 
     201      !!---------------------------------------------------------------------- 
     202      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr 
     203      !!---------------------------------------------------------------------- 
     204      ! 
     205      REWIND ( numnam )               ! Read Namelist namzdf_ddm : double diffusion mixing scheme 
     206      READ   ( numnam, namzdf_ddm ) 
    228207      ! 
    229208      IF(lwp) THEN                    ! Parameter print 
    … …  
    231210         WRITE(numout,*) 'zdf_ddm : double diffusive mixing' 
    232211         WRITE(numout,*) '~~~~~~~' 
    233          WRITE(numout,*) '   Namelist nam_ddm : set dd mixing parameter' 
     212         WRITE(numout,*) '   Namelist namzdf_ddm : set dd mixing parameter' 
    234213         WRITE(numout,*) '      maximum avs for dd mixing      rn_avts   = ', rn_avts 
    235214         WRITE(numout,*) '      heat/salt buoyancy flux ratio  rn_hsbfr  = ', rn_hsbfr 

  • trunk/NEMO/OPA_SRC/ZDF/zdfini.F90

    r1559 r1601  
    5454      INTEGER ::   ioptio       ! temporary scalar 
    5555      !! 
    56       NAMELIST/nam_zdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   & 
     56      NAMELIST/namzdf/ rn_avm0, rn_avt0, nn_avb, nn_havtb, ln_zdfexp, nn_zdfexp,   & 
    5757         &              ln_zdfevd, nn_evdm, rn_avevd, ln_zdfnpc, nn_npc, nn_npcp 
    5858      !!---------------------------------------------------------------------- 
    5959 
    60       REWIND( numnam )           !* Read nam_zdf namelist : vertical mixing parameters 
    61       READ  ( numnam, nam_zdf ) 
     60      REWIND( numnam )           !* Read namzdf namelist : vertical mixing parameters 
     61      READ  ( numnam, namzdf ) 
    6262 
    6363      IF(lwp) THEN               !* Parameter print 
    … …  
    6565         WRITE(numout,*) 'zdf_init: vertical physics' 
    6666         WRITE(numout,*) '~~~~~~~~' 
    67          WRITE(numout,*) '   Namelist nam_zdf : set vertical mixing mixing parameters' 
     67         WRITE(numout,*) '   Namelist namzdf : set vertical mixing mixing parameters' 
    6868         WRITE(numout,*) '      vertical eddy viscosity             rn_avm0   = ', rn_avm0 
    6969         WRITE(numout,*) '      vertical eddy diffusivity           rn_avt0   = ', rn_avt0 

  • trunk/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r1537 r1601  
    3838   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfkpp = .TRUE.    !: KPP vertical mixing flag 
    3939 
    40    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ghats   !: non-local scalar mixing term (gamma/<ws>o) 
    41    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   &  
    42       wt0                   ,  &  !: surface temperature flux for non local flux 
    43       ws0                   ,  &  !: surface salinity flux for non local flux 
    44       hkpp                        !: boundary layer depht 
    45  
    46    !                                        !!* Namelist nam_zdfkpp * 
     40   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   ghats    !: non-local scalar mixing term (gamma/<ws>o) 
     41   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   wt0      !: surface temperature flux for non local flux 
     42   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   ws0      !: surface salinity flux for non local flux 
     43   REAL(wp), PUBLIC, DIMENSION(jpi,jpj)     ::   hkpp     !: boundary layer depht 
     44 
     45   !                                        !!* Namelist namzdf_kpp * 
    4746   REAL(wp) ::   rn_difmiw  =  1.2e-04_wp    ! constant internal wave viscosity (m2/s) 
    4847   REAL(wp) ::   rn_difsiw  =  1.2e-05_wp    ! constant internal wave diffusivity (m2/s) 
    … …  
    5958      difsdc  = 1.5e-06_wp       ! maximum diffusive convection mixing 
    6059#endif 
    61    LOGICAL  ::                 & 
    62       ln_kpprimix  = .TRUE.       ! Shear instability mixing  
     60   LOGICAL  ::   ln_kpprimix  = .TRUE.       ! Shear instability mixing  
    6361 
    6462   REAL(wp) ::                 & !!! ** General constants  ** 
    … …  
    9290 
    9391#if ! defined key_kppcustom 
    94    REAL(wp), DIMENSION(jpk,jpk) ::   &  
    95       del                         ! array for reference mean values of vertical integration  
     92   REAL(wp), DIMENSION(jpk,jpk) ::   del   ! array for reference mean values of vertical integration  
    9693#endif 
    9794 
    … …  
    103100      njlktbm1 = njlktb - 1       ! 
    104101 
    105    REAL(wp), DIMENSION(nilktb,njlktb) ::  & 
    106       wmlktb                ,  &  ! lookup table for the turbulent vertical velocity scale for momentum 
    107       wslktb                       ! lookup table for the turbulent vertical velocity scale for tracers 
     102   REAL(wp), DIMENSION(nilktb,njlktb) ::   wmlktb   ! lookup table for the turbulent vertical velocity scale for momentum 
     103   REAL(wp), DIMENSION(nilktb,njlktb) ::   wslktb   ! lookup table for the turbulent vertical velocity scale for tracers 
    108104 
    109105   REAL(wp) ::                 & 
    … …  
    115111      deustar                     ! delta ustar in lookup table 
    116112#endif 
    117    REAL(wp), DIMENSION(jpk) :: &  !!! attenuation coef   
    118       ratt         
    119    !! already defines in module traqsr, but only if the solar radiation penetration is considered 
     113   REAL(wp), DIMENSION(jpk) ::   ratt   ! attenuation coef  (already defines in module traqsr,  
     114   !                                    ! but only if the solar radiation penetration is considered) 
    120115   REAL(wp) ::                 & !!! * penetrative solar radiation coefficient * 
    121116      rabs = 0.58_wp        ,  &  ! fraction associated with xsi1 
    … …  
    135130      buof                  ,  &  ! buoyancy forcing 
    136131      mols                        ! moning-Obukhov length scale  
    137    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   & 
    138       ekdp                        ! Ekman depth 
    139 #endif 
    140  
    141    INTEGER  ::  &                 ! 
    142       jip = 62 , jjp = 111 
     132   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ekdp   ! Ekman depth 
     133#endif 
     134 
     135   INTEGER  ::   jip = 62 , jjp = 111 
    143136 
    144137   !! * Substitutions 
    … …  
    147140#  include  "zdfddm_substitute.h90" 
    148141   !!---------------------------------------------------------------------- 
    149    !!   OPA 9.0 , LOCEAN-IPSL   (2005) 
     142   !! NEMO/OPA 3.2 , LOCEAN-IPSL   (2009) 
    150143   !! $Id$ 
    151144   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    … …  
    419412      DO jj = 2, jpjm1 
    420413         DO ji = fs_2, fs_jpim1      
    421             IF( neos < 1) THEN    
     414            IF( nn_eos < 1) THEN    
    422415               zt     = tn(ji,jj,1) 
    423416               zs     = sn(ji,jj,1) - 35.0 
    … …  
    454447            ELSE 
    455448               zrhos    = rhop(ji,jj,1) + rau0 * ( 1. - tmask(ji,jj,1) ) 
    456                zthermal = ralpha / ( rcp * zrhos + epsln ) 
    457                zhalin   = rbeta * sn(ji,jj,1) * rcs 
     449               zthermal = rn_alpha / ( rcp * zrhos + epsln ) 
     450               zhalin   = rn_beta * sn(ji,jj,1) * rcs 
    458451            ENDIF 
    459452            ! Radiative surface buoyancy force 
    … …  
    468461      ENDDO 
    469462 
    470       zflageos = 0.5 + SIGN( 0.5, neos - 1. )  
     463      zflageos = 0.5 + SIGN( 0.5, nn_eos - 1. )  
    471464      !  Compute surface buoyancy forcing, Monin Obukhov and Ekman depths   
    472465      !------------------------------------------------------------------     
    … …  
    597590               ! potential density of water(ztref,zsref at level jk): 
    598591               ! compute volumic mass pure water at atm pressure 
    599                IF ( neos < 1 ) THEN 
     592               IF ( nn_eos < 1 ) THEN 
    600593                  zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   & 
    601594                     &       -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594 
    … …  
    13451338         ll_kpplktb                ! Lookup table for turbul. velocity scales  
    13461339      !! 
    1347       NAMELIST/nam_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave 
     1340      NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave 
    13481341      !!---------------------------------------------------------------------- 
    13491342 
    13501343      REWIND ( numnam )               ! Read Namelist namkpp : K-Profile Parameterisation 
    1351       READ   ( numnam, nam_kpp ) 
     1344      READ   ( numnam, namzdf_kpp ) 
    13521345 
    13531346      IF(lwp) THEN                    ! Control print 
    … …  
    13551348         WRITE(numout,*) 'zdf_kpp_init : K-Profile Parameterisation' 
    13561349         WRITE(numout,*) '~~~~~~~~~~~~' 
    1357          WRITE(numout,*) '   Namelist nam_kpp : set tke mixing parameters' 
     1350         WRITE(numout,*) '   Namelist namzdf_kpp : set tke mixing parameters' 
    13581351         WRITE(numout,*) '     Shear instability mixing                      ln_kpprimix = ', ln_kpprimix 
    13591352         WRITE(numout,*) '     max. internal wave viscosity                  rn_difmiw   = ', rn_difmiw 

  • trunk/NEMO/OPA_SRC/ZDF/zdfric.F90

    r1537 r1601  
    55   !!                 Richardson number dependent formulation 
    66   !!====================================================================== 
     7   !! History :  OPA  ! 1987-09  (P. Andrich)  Original code 
     8   !!            4.0  ! 1991-11  (G. Madec) 
     9   !!            7.0  ! 1996-01  (G. Madec)  complet rewriting of multitasking suppression of common work arrays 
     10   !!            8.0  ! 1997-06 (G. Madec)  complete rewriting of zdfmix 
     11   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     12   !!---------------------------------------------------------------------- 
    713#if defined key_zdfric   ||   defined key_esopa 
    814   !!---------------------------------------------------------------------- 
    … …  
    2632   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfric = .TRUE.   !: Richardson vertical mixing flag 
    2733 
    28    !                                    !!* Namelist nam_ric : Richardson number dependent Kz * 
    29    INTEGER  ::   nn_ric  = 2             ! coefficient of the parameterization 
     34   !                                    !!* Namelist namzdf_ric : Richardson number dependent Kz * 
     35   INTEGER  ::   nn_ric   = 2            ! coefficient of the parameterization 
    3036   REAL(wp) ::   rn_avmri = 100.e-4_wp   ! maximum value of the vertical eddy viscosity 
    3137   REAL(wp) ::   rn_alp   =   5._wp      ! coefficient of the parameterization 
    … …  
    4753      !!                     
    4854      !! ** Purpose :   Compute the before eddy viscosity and diffusivity as 
    49       !!      a function of the local richardson number. 
     55      !!              a function of the local richardson number. 
    5056      !! 
    5157      !! ** Method  :   Local richardson number dependent formulation of the  
    52       !!      vertical eddy viscosity and diffusivity coefficients. the eddy 
    53       !!      coefficients are given by: 
    54       !!              avm = avm0 + avmb 
    55       !!              avt = avm0 / (1 + rn_alp*ri) 
    56       !!      with    ri  = N^2 / dz(u)**2 
    57       !!                  = e3w**2 * rn2/[ mi( dk(ub) )+mj( dk(vb) ) ] 
    58       !!              avm0= rn_avmri / (1 + rn_alp*ri)**nn_ric 
    59       !!      Where ri is the before local Richardson number, rn_avmri the maximum 
    60       !!      value reaches by the vertical eddy coefficients, avmb and avtb 
    61       !!      the background (or minimum) values of these coefficients for 
    62       !!      momemtum and tracers, and rn_alp, nn_ric are adjustable parameters. 
    63       !!      typical values used are : avm0=1.e-2 m2/s, avmb=1.e-6 m2/s 
     58      !!              vertical eddy viscosity and diffusivity coefficients.  
     59      !!                The eddy coefficients are given by: 
     60      !!                    avm = avm0 + avmb 
     61      !!                    avt = avm0 / (1 + rn_alp*ri) 
     62      !!              with ri  = N^2 / dz(u)**2 
     63      !!                       = e3w**2 * rn2/[ mi( dk(ub) )+mj( dk(vb) ) ] 
     64      !!                   avm0= rn_avmri / (1 + rn_alp*ri)**nn_ric 
     65      !!      Where ri is the before local Richardson number, 
     66      !!            rn_avmri is the maximum value reaches by avm and avt  
     67      !!            avmb and avtb are the background (or minimum) values 
     68      !!            and rn_alp, nn_ric are adjustable parameters. 
     69      !!      Typical values used are : avm0=1.e-2 m2/s, avmb=1.e-6 m2/s 
    6470      !!      avtb=1.e-7 m2/s, rn_alp=5. and nn_ric=2. 
    65       !!      this formulation needs ri>=0 : ri is set to zero if dz(rau)<0. 
    6671      !!      a numerical threshold is impose on the vertical shear (1.e-20) 
    6772      !!        N.B. the mask are required for implicit scheme, and surface 
    68       !!      and bottom value already set in inimix.F 
    69       !! 
    70       !! References : 
    71       !!      pacanowski & philander 1981, j. phys. oceanogr., 1441-1451. 
    72       !! History : 
    73       !!        !  87-09  (P. Andrich)  Original code 
    74       !!        !  91-11  (G. Madec) 
    75       !!        !  93-03  (M. Guyon)  symetrical conditions 
    76       !!        !  96-01  (G. Madec)  complet rewriting of multitasking 
    77       !!                                  suppression of common work arrays 
    78       !!        !  97-06 (G. Madec)  complete rewriting of zdfmix 
    79       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
     73      !!      and bottom value already set in zdfini.F90 
     74      !! 
     75      !! References : Pacanowski & Philander 1981, JPO, 1441-1451. 
    8076      !!---------------------------------------------------------------------- 
    8177      INTEGER, INTENT( in ) ::   kt         ! ocean time-step indexocean time step 
    … …  
    9389         ! Richardson number (put in zwx(ji,jj)) 
    9490         ! ----------------- 
    95          ! minimum value set to zero 
    9691         DO jj = 2, jpjm1 
    9792            DO ji = 2, jpim1 
    9893               zcoef = 0.5 / fse3w(ji,jj,jk) 
    99                ! shear of horizontal velocity 
     94               !                                            ! shear of horizontal velocity 
    10095               zdku = zcoef * (  ub(ji-1,jj,jk-1) + ub(ji,jj,jk-1)   & 
    10196                  &             -ub(ji-1,jj,jk  ) - ub(ji,jj,jk  )  ) 
    10297               zdkv = zcoef * (  vb(ji,jj-1,jk-1) + vb(ji,jj,jk-1)   & 
    10398                  &             -vb(ji,jj-1,jk  ) - vb(ji,jj,jk  )  ) 
    104                ! richardson number (minimum value set to zero) 
     99               !                                            ! richardson number (minimum value set to zero) 
    105100               zri = rn2(ji,jj,jk) / ( zdku*zdku + zdkv*zdkv + 1.e-20 ) 
    106101               zwx(ji,jj) = MAX( zri, 0.e0 ) 
    107102            END DO 
    108103         END DO 
    109  
    110          ! Boundary condition on zwx   (sign unchanged) 
    111          CALL lbc_lnk( zwx, 'W', 1. ) 
     104         CALL lbc_lnk( zwx, 'W', 1. )                       ! Boundary condition   (sign unchanged) 
    112105 
    113106 
    114107         ! Vertical eddy viscosity and diffusivity coefficients 
    115108         ! ------------------------------------------------------- 
    116          ! Eddy viscosity coefficients 
    117109         z05alp = 0.5 * rn_alp 
    118          DO jj = 1, jpjm1 
     110         DO jj = 1, jpjm1                                   ! Eddy viscosity coefficients (avm) 
    119111            DO ji = 1, jpim1 
    120112               avmu(ji,jj,jk) = umask(ji,jj,jk)   & 
    … …  
    124116            END DO 
    125117         END DO 
    126  
    127          ! Eddy diffusivity coefficients 
    128          DO jj = 2, jpjm1 
     118         DO jj = 2, jpjm1                                   ! Eddy diffusivity coefficients (avt) 
    129119            DO ji = 2, jpim1 
    130120               avt(ji,jj,jk) = tmric(ji,jj,jk) / ( 1. + rn_alp * zwx(ji,jj) )   & 
    … …  
    132122                  &             + avmv(ji,jj,jk) + avmv( ji ,jj-1,jk)  )     & 
    133123                  &          + avtb(jk) * tmask(ji,jj,jk) 
    134             END DO 
    135          END DO 
    136  
    137          ! Add the background coefficient on eddy viscosity 
    138          DO jj = 2, jpjm1 
    139             DO ji = 2, jpim1 
     124               !                                            ! Add the background coefficient on eddy viscosity 
    140125               avmu(ji,jj,jk) = avmu(ji,jj,jk) + avmb(jk) * umask(ji,jj,jk) 
    141126               avmv(ji,jj,jk) = avmv(ji,jj,jk) + avmb(jk) * vmask(ji,jj,jk) 
    … …  
    145130      END DO                                           !   End of slab 
    146131      !                                                ! =============== 
    147  
    148       ! Boundary conditions on (avt,avmu,avmv)   (unchanged sign) 
    149       ! -----------------------=============== 
    150       CALL lbc_lnk( avt , 'W', 1. ) 
    151       CALL lbc_lnk( avmu, 'U', 1. ) 
    152       CALL lbc_lnk( avmv, 'V', 1. ) 
    153  
     132      ! 
     133      CALL lbc_lnk( avt , 'W', 1. )                         ! Boundary conditions   (unchanged sign) 
     134      CALL lbc_lnk( avmu, 'U', 1. )   ;   CALL lbc_lnk( avmv, 'V', 1. ) 
     135      ! 
    154136   END SUBROUTINE zdf_ric 
    155137 
    … …  
    162144      !!      viscosity coef. for the Richardson number dependent formulation. 
    163145      !! 
    164       !! ** Method  :   Read the namric namelist and check the parameter values 
    165       !! 
    166       !! ** input   :   Namelist namric 
     146      !! ** Method  :   Read the namzdf_ric namelist and check the parameter values 
     147      !! 
     148      !! ** input   :   Namelist namzdf_ric 
    167149      !! 
    168150      !! ** Action  :   increase by 1 the nstop flag is setting problem encounter 
    169       !! 
    170       !! history : 
    171       !!  8.5  !  02-06  (G. Madec)  original code 
    172151      !!---------------------------------------------------------------------- 
    173152      INTEGER :: ji, jj, jk        ! dummy loop indices 
    174153      !! 
    175       NAMELIST/nam_ric/ rn_avmri, rn_alp, nn_ric 
    176       !!---------------------------------------------------------------------- 
    177  
    178       REWIND ( numnam )               ! Read Namelist nam_ric : richardson number dependent Kz 
    179       READ   ( numnam, nam_ric ) 
    180  
    181       IF(lwp) THEN                    ! Control print 
     154      NAMELIST/namzdf_ric/ rn_avmri, rn_alp, nn_ric 
     155      !!---------------------------------------------------------------------- 
     156      ! 
     157      REWIND( numnam )               ! Read Namelist namzdf_ric : richardson number dependent Kz 
     158      READ  ( numnam, namzdf_ric ) 
     159      ! 
     160      IF(lwp) THEN                   ! Control print 
    182161         WRITE(numout,*) 
    183162         WRITE(numout,*) 'zdf_ric : Ri depend vertical mixing scheme' 
    184163         WRITE(numout,*) '~~~~~~~' 
    185          WRITE(numout,*) '   Namelist namric : set Kz(Ri) parameters' 
     164         WRITE(numout,*) '   Namelist namzdf_ric : set Kz(Ri) parameters' 
    186165         WRITE(numout,*) '      maximum vertical viscosity     rn_avmri = ', rn_avmri 
    187166         WRITE(numout,*) '      coefficient                    rn_alp   = ', rn_alp 
    188167         WRITE(numout,*) '      coefficient                    nn_ric   = ', nn_ric 
    189168      ENDIF 
    190  
    191       ! weighting mean array tmric for 4 T-points which accounts for coastal boundary conditions. 
    192       DO jk = 1, jpk 
    193          DO jj = 2, jpj 
     169      ! 
     170      DO jk = 1, jpk                 ! weighting mean array tmric for 4 T-points which accounts for coastal boundary conditions. 
     171         DO jj = 2, jpj               
    194172            DO ji = 2, jpi 
    195173               tmric(ji,jj,jk) =  tmask(ji,jj,jk)                                  & 
    196                                / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   & 
    197                                          + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  ) 
     174                  &            / MAX( 1.,  umask(ji-1,jj  ,jk) + umask(ji,jj,jk)   & 
     175                  &                      + vmask(ji  ,jj-1,jk) + vmask(ji,jj,jk)  ) 
    198176            END DO 
    199177         END DO 
    200178      END DO 
    201179      tmric(:,1,:) = 0.e0 
    202  
    203       ! Initialization of vertical eddy coef. to the background value 
    204       DO jk = 1, jpk 
     180      ! 
     181      DO jk = 1, jpk                 ! Initialization of vertical eddy coef. to the background value 
    205182         avt (:,:,jk) = avtb(jk) * tmask(:,:,jk) 
    206183         avmu(:,:,jk) = avmb(jk) * umask(:,:,jk) 
    207184         avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk) 
    208185      END DO 
    209  
     186      ! 
    210187   END SUBROUTINE zdf_ric_init 
    211188 

  • trunk/NEMO/OPA_SRC/ZDF/zdftke.F90

    r1537 r1601  
    6363#endif 
    6464 
    65    !                                       !!! ** Namelist  nam_tke  ** 
     65   !                                       !!! ** Namelist  namzdf_tke  ** 
    6666   LOGICAL  ::   ln_mxl0  = .FALSE.         ! mixing length scale surface value as function of wind stress or not 
    6767   INTEGER  ::   nn_mxl   =  2              ! type of mixing length (=0/1/2/3) 
    … …  
    616616      !!              viscosity when using a tke turbulent closure scheme 
    617617      !! 
    618       !! ** Method  :   Read the nam_tke namelist and check the parameters 
     618      !! ** Method  :   Read the namzdf_tke namelist and check the parameters 
    619619      !!              called at the first timestep (nit000) 
    620620      !! 
    621       !! ** input   :   Namlist nam_tke 
     621      !! ** input   :   Namlist namzdf_tke 
    622622      !! 
    623623      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter 
    … …  
    625625      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    626626      !! 
    627       NAMELIST/nam_tke/ rn_ediff, rn_ediss , rn_ebb, rn_emin,   & 
    628          &              rn_emin0, rn_bshear, nn_mxl, ln_mxl0,   & 
    629          &              rn_lmin , rn_lmin0 , nn_pdl, nn_etau,   & 
    630          &              nn_htau , rn_efr   , ln_lc , rn_lc  
    631       !!---------------------------------------------------------------------- 
    632  
    633       REWIND ( numnam )               !* Read Namelist nam_tke : Turbulente Kinetic Energy 
    634       READ   ( numnam, nam_tke ) 
     627      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb, rn_emin,   & 
     628         &                 rn_emin0, rn_bshear, nn_mxl, ln_mxl0,   & 
     629         &                 rn_lmin , rn_lmin0 , nn_pdl, nn_etau,   & 
     630         &                 nn_htau , rn_efr   , ln_lc , rn_lc  
     631      !!---------------------------------------------------------------------- 
     632 
     633      REWIND ( numnam )               !* Read Namelist namzdf_tke : Turbulente Kinetic Energy 
     634      READ   ( numnam, namzdf_tke ) 
    635635       
    636636      ri_cri = 2. / ( 2. + rn_ediss / rn_ediff )      ! resulting critical Richardson number 
    … …  
    640640         WRITE(numout,*) 'zdf_tke : tke turbulent closure scheme - initialisation' 
    641641         WRITE(numout,*) '~~~~~~~~' 
    642          WRITE(numout,*) '          Namelist nam_tke : set tke mixing parameters' 
    643          WRITE(numout,*) '             coef. to compute avt                      rn_ediff = ', rn_ediff 
    644          WRITE(numout,*) '             Kolmogoroff dissipation coef.             rn_ediss = ', rn_ediss 
    645          WRITE(numout,*) '             tke surface input coef.                   rn_ebb   = ', rn_ebb 
    646          WRITE(numout,*) '             minimum value of tke                      rn_emin  = ', rn_emin 
    647          WRITE(numout,*) '             surface minimum value of tke              rn_emin0 = ', rn_emin0 
    648          WRITE(numout,*) '             background shear (>0)                     rn_bshear= ', rn_bshear 
    649          WRITE(numout,*) '             mixing length type                        nn_mxl   = ', nn_mxl 
    650          WRITE(numout,*) '             prandl number flag                        nn_pdl   = ', nn_pdl 
    651          WRITE(numout,*) '             surface mixing length = F(stress) or not  ln_mxl0  = ', ln_mxl0 
    652          WRITE(numout,*) '             surface  mixing length minimum value      rn_lmin0 = ', rn_lmin0 
    653          WRITE(numout,*) '             interior mixing length minimum value      rn_lmin0 = ', rn_lmin0 
    654          WRITE(numout,*) '             test param. to add tke induced by wind    nn_etau  = ', nn_etau 
    655          WRITE(numout,*) '             flag for computation of exp. tke profile  nn_htau  = ', nn_htau 
    656          WRITE(numout,*) '             % of rn_emin0 which pene. the thermocline rn_efr   = ', rn_efr 
    657          WRITE(numout,*) '             flag to take into acc.  Langmuir circ.    ln_lc    = ', ln_lc 
    658          WRITE(numout,*) '             coef to compute verticla velocity of LC   rn_lc    = ', rn_lc 
     642         WRITE(numout,*) '   Namelist namzdf_tke : set tke mixing parameters' 
     643         WRITE(numout,*) '      coef. to compute avt                        rn_ediff = ', rn_ediff 
     644         WRITE(numout,*) '      Kolmogoroff dissipation coef.               rn_ediss = ', rn_ediss 
     645         WRITE(numout,*) '      tke surface input coef.                     rn_ebb   = ', rn_ebb 
     646         WRITE(numout,*) '      minimum value of tke                        rn_emin  = ', rn_emin 
     647         WRITE(numout,*) '      surface minimum value of tke                rn_emin0 = ', rn_emin0 
     648         WRITE(numout,*) '      background shear (>0)                       rn_bshear= ', rn_bshear 
     649         WRITE(numout,*) '      mixing length type                          nn_mxl   = ', nn_mxl 
     650         WRITE(numout,*) '      prandl number flag                          nn_pdl   = ', nn_pdl 
     651         WRITE(numout,*) '      surface mixing length = F(stress) or not    ln_mxl0  = ', ln_mxl0 
     652         WRITE(numout,*) '      surface  mixing length minimum value        rn_lmin0 = ', rn_lmin0 
     653         WRITE(numout,*) '      interior mixing length minimum value        rn_lmin0 = ', rn_lmin0 
     654         WRITE(numout,*) '      test param. to add tke induced by wind      nn_etau  = ', nn_etau 
     655         WRITE(numout,*) '      flag for computation of exp. tke profile    nn_htau  = ', nn_htau 
     656         WRITE(numout,*) '      % of rn_emin0 which pene. the thermocline  rn_efr   = ', rn_efr 
     657         WRITE(numout,*) '      flag to take into acc.  Langmuir circ.      ln_lc    = ', ln_lc 
     658         WRITE(numout,*) '      coef to compute verticla velocity of LC     rn_lc    = ', rn_lc 
    659659         WRITE(numout,*) 
    660          WRITE(numout,*) '             critical Richardson nb with your choice of coefs. = ', ri_cri 
     660         WRITE(numout,*) '      critical Richardson nb with your parameters  ri_cri = ', ri_cri 
    661661      ENDIF 
    662662 
    … …  
    671671      !                               !* depth of penetration of surface tke 
    672672      IF( nn_etau /= 0 ) THEN       
    673          SELECT CASE( nn_htau )           ! Choice of the depth of penetration 
     673         SELECT CASE( nn_htau )             ! Choice of the depth of penetration 
    674674         CASE( 0 )                                    ! constant depth penetration (here 10 meters) 
    675675            htau(:,:) = 10.e0 
    … …  
    760760        !                                   ! ------------------- 
    761761        IF(lwp) WRITE(numout,*) '---- tke-rst ----' 
    762         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     ) 
    763         CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt    ) 
    764         CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm    ) 
    765         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu   ) 
    766         CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv   ) 
    767         CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl  ) 
     762        CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    ) 
     763        CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt   ) 
     764        CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm   ) 
     765        CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu  ) 
     766        CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv  ) 
     767        CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl ) 
    768768        ! 
    769769     ENDIF 

  • trunk/NEMO/OPA_SRC/ZDF/zdftke_old.F90

    r1537 r1601  
    6565#endif 
    6666 
    67    !                                       !!! ** Namelist  nam_tke  ** 
     67   !                                       !!! ** Namelist  namzdf_tke  ** 
    6868   LOGICAL  ::   ln_rstke = .FALSE.         ! =T restart with tke from a run without tke 
    6969   LOGICAL  ::   ln_mxl0  = .FALSE.         ! mixing length scale surface value as function of wind stress or not 
    … …  
    710710      !!      viscosity when using a tke turbulent closure scheme 
    711711      !! 
    712       !! ** Method  :   Read the nam_tke namelist and check the parameters 
     712      !! ** Method  :   Read the namzdf_tke namelist and check the parameters 
    713713      !!      called at the first timestep (nit000) 
    714714      !! 
    715       !! ** input   :   Namlist nam_tke 
     715      !! ** input   :   Namlist namzdf_tke 
    716716      !! 
    717717      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter 
    … …  
    727727# endif 
    728728      !! 
    729       NAMELIST/nam_tke/ ln_rstke, rn_ediff, rn_ediss, rn_ebb  , rn_efave, rn_emin,   & 
    730          &              rn_emin0, rn_cri  , nn_itke , nn_mxl  , nn_pdl  , nn_ave ,   & 
    731          &              ln_mxl0 , rn_lmin , rn_lmin0, nn_etau,   & 
    732          &              nn_htau , rn_efr  , ln_lc   , rn_lc  
     729      NAMELIST/namzdf_tke/ ln_rstke, rn_ediff, rn_ediss, rn_ebb  , rn_efave, rn_emin,   & 
     730         &                 rn_emin0, rn_cri  , nn_itke , nn_mxl  , nn_pdl  , nn_ave ,   & 
     731         &                 ln_mxl0 , rn_lmin , rn_lmin0, nn_etau,   & 
     732         &                 nn_htau , rn_efr  , ln_lc   , rn_lc  
    733733      !!---------------------------------------------------------------------- 
    734734 
    735       ! Read Namelist nam_tke : Turbulente Kinetic Energy 
     735      ! Read Namelist namzdf_tke : Turbulente Kinetic Energy 
    736736      ! -------------------- 
    737737      REWIND ( numnam ) 
    738       READ   ( numnam, nam_tke ) 
     738      READ   ( numnam, namzdf_tke ) 
    739739 
    740740      ! Compute boost associated with the Richardson critic 
    … …  
    752752         WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme (old scheme)' 
    753753         WRITE(numout,*) '~~~~~~~~~~~~' 
    754          WRITE(numout,*) '          Namelist nam_tke : set tke mixing parameters' 
     754         WRITE(numout,*) '          Namelist namzdf_tke : set tke mixing parameters' 
    755755         WRITE(numout,*) '             restart with tke from no tke              ln_rstke = ', ln_rstke 
    756756         WRITE(numout,*) '             coef. to compute avt                      rn_ediff = ', rn_ediff 

  • trunk/NEMO/OPA_SRC/ZDF/zdftmx.F90

    r1546 r1601  
    3131   LOGICAL, PUBLIC, PARAMETER ::   lk_zdftmx = .TRUE.    !: tidal mixing flag 
    3232 
    33    !                                  !!* Namelist  namtmx : tidal mixing * 
     33   !                                  !!* Namelist  namzdf_tmx : tidal mixing * 
    3434   REAL(wp) ::  rn_htmx    = 500.      ! vertical decay scale for turbulence (meters) 
    3535   REAL(wp) ::  rn_n2min   = 1.e-8     ! threshold of the Brunt-Vaisala frequency (s-1) 
    … …  
    8888      !!              Koch-Larrouy et al. 2007, GRL. 
    8989      !!---------------------------------------------------------------------- 
    90       USE oce,   zav_tide  =>   ua   ! use ua as workspace 
     90      USE oce, zav_tide  =>   ua    ! use ua as workspace 
    9191      !! 
    9292      INTEGER, INTENT(in) ::   kt   ! ocean time-step  
    … …  
    329329      REAL(wp), DIMENSION(jpi,jpj,jpk) ::  zpc      ! power consumption 
    330330      !! 
    331       NAMELIST/nam_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf 
    332       !!---------------------------------------------------------------------- 
    333  
    334       REWIND ( numnam )              ! Read Namelist namtmx : Tidal Mixing 
    335       READ   ( numnam, nam_tmx ) 
     331      NAMELIST/namzdf_tmx/ rn_htmx, rn_n2min, rn_tfe, rn_me, ln_tmx_itf, rn_tfe_itf 
     332      !!---------------------------------------------------------------------- 
     333 
     334      REWIND( numnam )               ! Read Namelist namtmx : Tidal Mixing 
     335      READ  ( numnam, namzdf_tmx ) 
    336336 
    337337      IF(lwp) THEN                   ! Control print 
    … …  
    339339         WRITE(numout,*) 'zdf_tmx_init : tidal mixing' 
    340340         WRITE(numout,*) '~~~~~~~~~~~~' 
    341          WRITE(numout,*) '   Namelist namtmx : set tidal mixing parameters' 
     341         WRITE(numout,*) '   Namelist namzdf_tmx : set tidal mixing parameters' 
    342342         WRITE(numout,*) '      Vertical decay scale for turbulence   = ', rn_htmx  
    343343         WRITE(numout,*) '      Brunt-Vaisala frequency threshold     = ', rn_n2min 

  • trunk/NEMO/OPA_SRC/eosbn2.F90

    r1559 r1601  
    99   !!            6.0  ! 1994-08  (G. Madec)  Add Jackett & McDougall eos 
    1010   !!            7.0  ! 1996-01  (G. Madec)  statement function for e3 
    11    !!            8.1  ! 1997-07  (G. Madec)  introduction of neos, OPA8.1 
    1211   !!            8.1  ! 1997-07  (G. Madec)  density instead of volumic mass 
    1312   !!             -   ! 1999-02  (G. Madec, N. Grima) semi-implicit pressure gradient 
    … …  
    5150   PUBLIC   tfreez     ! called by sbcice_... modules 
    5251 
    53    !                                      !!* Namelist (nameos) * 
    54    INTEGER , PUBLIC ::   neos   = 0        !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
    55    REAL(wp), PUBLIC ::   ralpha = 2.0e-4   !: thermal expension coeff. (linear equation of state) 
    56    REAL(wp), PUBLIC ::   rbeta  = 7.7e-4   !: saline  expension coeff. (linear equation of state) 
     52   !                                        !!* Namelist (nameos) * 
     53   INTEGER , PUBLIC ::   nn_eos   = 0        !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 
     54   REAL(wp), PUBLIC ::   rn_alpha = 2.0e-4   !: thermal expension coeff. (linear equation of state) 
     55   REAL(wp), PUBLIC ::   rn_beta  = 7.7e-4   !: saline  expension coeff. (linear equation of state) 
     56 
    5757   REAL(wp), PUBLIC ::   ralpbet           !: alpha / beta ratio 
    5858    
    … …  
    7474      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from  
    7575      !!       potential temperature and salinity using an equation of state 
    76       !!       defined through the namelist parameter neos. 
     76      !!       defined through the namelist parameter nn_eos. 
    7777      !! 
    7878      !! ** Method  :   3 cases: 
    79       !!      neos = 0 : Jackett and McDougall (1994) equation of state. 
     79      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    8080      !!         the in situ density is computed directly as a function of 
    8181      !!         potential temperature relative to the surface (the opa t 
    … …  
    9292      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    9393      !!          t = 40 deg celcius, s=40 psu 
    94       !!      neos = 1 : linear equation of state function of temperature only 
    95       !!              prd(t) = 0.0285 - ralpha * t 
    96       !!      neos = 2 : linear equation of state function of temperature and 
     94      !!      nn_eos = 1 : linear equation of state function of temperature only 
     95      !!              prd(t) = 0.0285 - rn_alpha * t 
     96      !!      nn_eos = 2 : linear equation of state function of temperature and 
    9797      !!               salinity 
    98       !!              prd(t,s) = rbeta * s - ralpha * tn - 1. 
     98      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    9999      !!      Note that no boundary condition problem occurs in this routine 
    100100      !!      as (ptem,psal) are defined over the whole domain. 
    … …  
    118118      !!---------------------------------------------------------------------- 
    119119 
    120       SELECT CASE( neos ) 
     120      SELECT CASE( nn_eos ) 
    121121      ! 
    122122      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    … …  
    169169      CASE( 1 )                !==  Linear formulation function of temperature only  ==! 
    170170         DO jk = 1, jpkm1 
    171             prd(:,:,jk) = ( 0.0285 - ralpha * ptem(:,:,jk) ) * tmask(:,:,jk) 
     171            prd(:,:,jk) = ( 0.0285 - rn_alpha * ptem(:,:,jk) ) * tmask(:,:,jk) 
    172172         END DO 
    173173         ! 
    174174      CASE( 2 )                !==  Linear formulation function of temperature and salinity  ==! 
    175175         DO jk = 1, jpkm1 
    176             prd(:,:,jk) = ( rbeta  * psal(:,:,jk) - ralpha * ptem(:,:,jk) ) * tmask(:,:,jk) 
    177          END DO 
    178          ! 
    179       CASE DEFAULT 
    180          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    181          CALL ctl_stop( ctmp1 ) 
     176            prd(:,:,jk) = ( rn_beta  * psal(:,:,jk) - rn_alpha * ptem(:,:,jk) ) * tmask(:,:,jk) 
     177         END DO 
    182178         ! 
    183179      END SELECT 
    … …  
    195191      !!      potential volumic mass (Kg/m3) from potential temperature and 
    196192      !!      salinity fields using an equation of state defined through the  
    197       !!     namelist parameter neos. 
     193      !!     namelist parameter nn_eos. 
    198194      !! 
    199195      !! ** Method  : 
    200       !!      neos = 0 : Jackett and McDougall (1994) equation of state. 
     196      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    201197      !!         the in situ density is computed directly as a function of 
    202198      !!         potential temperature relative to the surface (the opa t 
    … …  
    216212      !!          t = 40 deg celcius, s=40 psu 
    217213      !! 
    218       !!      neos = 1 : linear equation of state function of temperature only 
    219       !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - ralpha * t 
     214      !!      nn_eos = 1 : linear equation of state function of temperature only 
     215      !!              prd(t) = ( rho(t) - rau0 ) / rau0 = 0.028 - rn_alpha * t 
    220216      !!              rhop(t,s)  = rho(t,s) 
    221217      !! 
    222       !!      neos = 2 : linear equation of state function of temperature and 
     218      !!      nn_eos = 2 : linear equation of state function of temperature and 
    223219      !!               salinity 
    224220      !!              prd(t,s) = ( rho(t,s) - rau0 ) / rau0  
    225       !!                       = rbeta * s - ralpha * tn - 1. 
     221      !!                       = rn_beta * s - rn_alpha * tn - 1. 
    226222      !!              rhop(t,s)  = rho(t,s) 
    227223      !!      Note that no boundary condition problem occurs in this routine 
    … …  
    245241      !!---------------------------------------------------------------------- 
    246242 
    247       SELECT CASE ( neos ) 
     243      SELECT CASE ( nn_eos ) 
    248244      ! 
    249245      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    … …  
    299295      CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    300296         DO jk = 1, jpkm1 
    301             prd  (:,:,jk) = ( 0.0285 - ralpha * ptem(:,:,jk) )        * tmask(:,:,jk) 
     297            prd  (:,:,jk) = ( 0.0285 - rn_alpha * ptem(:,:,jk) )        * tmask(:,:,jk) 
    302298            prhop(:,:,jk) = ( 1.e0   +          prd (:,:,jk) ) * rau0 * tmask(:,:,jk) 
    303299         END DO 
    … …  
    305301      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    306302         DO jk = 1, jpkm1 
    307             prd  (:,:,jk) = ( rbeta  * psal(:,:,jk) - ralpha * ptem(:,:,jk) )        * tmask(:,:,jk) 
     303            prd  (:,:,jk) = ( rn_beta  * psal(:,:,jk) - rn_alpha * ptem(:,:,jk) )        * tmask(:,:,jk) 
    308304            prhop(:,:,jk) = ( 1.e0   + prd (:,:,jk) )                         * rau0 * tmask(:,:,jk) 
    309305         END DO 
    310          ! 
    311       CASE DEFAULT 
    312          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    313          CALL ctl_stop( ctmp1 ) 
    314306         ! 
    315307      END SELECT 
    … …  
    326318      !! ** Purpose :   Compute the in situ density (ratio rho/rau0) from  
    327319      !!      potential temperature and salinity using an equation of state 
    328       !!      defined through the namelist parameter neos. * 2D field case 
     320      !!      defined through the namelist parameter nn_eos. * 2D field case 
    329321      !! 
    330322      !! ** Method : 
    331       !!      neos = 0 : Jackett and McDougall (1994) equation of state. 
     323      !!      nn_eos = 0 : Jackett and McDougall (1994) equation of state. 
    332324      !!         the in situ density is computed directly as a function of 
    333325      !!         potential temperature relative to the surface (the opa t 
    … …  
    344336      !!         Check value: rho = 1060.93298 kg/m**3 for p=10000 dbar, 
    345337      !!          t = 40 deg celcius, s=40 psu 
    346       !!      neos = 1 : linear equation of state function of temperature only 
    347       !!              prd(t) = 0.0285 - ralpha * t 
    348       !!      neos = 2 : linear equation of state function of temperature and 
     338      !!      nn_eos = 1 : linear equation of state function of temperature only 
     339      !!              prd(t) = 0.0285 - rn_alpha * t 
     340      !!      nn_eos = 2 : linear equation of state function of temperature and 
    349341      !!               salinity 
    350       !!              prd(t,s) = rbeta * s - ralpha * tn - 1. 
     342      !!              prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 
    351343      !!      Note that no boundary condition problem occurs in this routine 
    352344      !!      as (ptem,psal) are defined over the whole domain. 
    … …  
    369361      prd(:,:) = 0.e0 
    370362 
    371       SELECT CASE( neos ) 
     363      SELECT CASE( nn_eos ) 
    372364      ! 
    373365      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    … …  
    424416         DO jj = 1, jpjm1 
    425417            DO ji = 1, fs_jpim1   ! vector opt. 
    426                prd(ji,jj) = ( 0.0285 - ralpha * ptem(ji,jj) ) * tmask(ji,jj,1) 
     418               prd(ji,jj) = ( 0.0285 - rn_alpha * ptem(ji,jj) ) * tmask(ji,jj,1) 
    427419            END DO 
    428420         END DO 
    … …  
    431423         DO jj = 1, jpjm1 
    432424            DO ji = 1, fs_jpim1   ! vector opt. 
    433                prd(ji,jj) = ( rbeta * psal(ji,jj) - ralpha * ptem(ji,jj) ) * tmask(ji,jj,1)  
    434             END DO 
    435          END DO 
    436          ! 
    437       CASE DEFAULT 
    438          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    439          CALL ctl_stop( ctmp1 ) 
     425               prd(ji,jj) = ( rn_beta * psal(ji,jj) - rn_alpha * ptem(ji,jj) ) * tmask(ji,jj,1)  
     426            END DO 
     427         END DO 
    440428         ! 
    441429      END SELECT 
    … …  
    454442      !!       
    455443      !! ** Method : 
    456       !!       * neos = 0  : UNESCO sea water properties 
     444      !!       * nn_eos = 0  : UNESCO sea water properties 
    457445      !!         The brunt-vaisala frequency is computed using the polynomial 
    458446      !!      polynomial expression of McDougall (1987): 
    … …  
    461449      !!      computed and used in zdfddm module : 
    462450      !!              Rrau = alpha/beta * ( dk[ t ] / dk[ s ] ) 
    463       !!       * neos = 1  : linear equation of state (temperature only) 
    464       !!            N^2 = grav * ralpha * dk[ t ]/e3w 
    465       !!       * neos = 2  : linear equation of state (temperature & salinity) 
    466       !!            N^2 = grav * (ralpha * dk[ t ] - rbeta * dk[ s ] ) / e3w 
     451      !!       * nn_eos = 1  : linear equation of state (temperature only) 
     452      !!            N^2 = grav * rn_alpha * dk[ t ]/e3w 
     453      !!       * nn_eos = 2  : linear equation of state (temperature & salinity) 
     454      !!            N^2 = grav * (rn_alpha * dk[ t ] - rn_beta * dk[ s ] ) / e3w 
    467455      !!      The use of potential density to compute N^2 introduces e r r o r 
    468456      !!      in the sign of N^2 at great depths. We recommand the use of  
    469       !!      neos = 0, except for academical studies. 
     457      !!      nn_eos = 0, except for academical studies. 
    470458      !!        Macro-tasked on horizontal slab (jk-loop) 
    471459      !!      N.B. N^2 is set to zero at the first level (JK=1) in inidtr 
    … …  
    490478      ! --------------------------  
    491479      ! 
    492       SELECT CASE( neos ) 
     480      SELECT CASE( nn_eos ) 
    493481      ! 
    494482      CASE( 0 )                !==  Jackett and McDougall (1994) formulation  ==! 
    … …  
    541529      CASE( 1 )                !==  Linear formulation = F( temperature )  ==! 
    542530         DO jk = 2, jpkm1 
    543             pn2(:,:,jk) = grav * ralpha * ( ptem(:,:,jk-1) - ptem(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     531            pn2(:,:,jk) = grav * rn_alpha * ( ptem(:,:,jk-1) - ptem(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    544532         END DO 
    545533         ! 
    546534      CASE( 2 )                !==  Linear formulation = F( temperature , salinity )  ==! 
    547535         DO jk = 2, jpkm1 
    548             pn2(:,:,jk) = grav * (  ralpha * ( ptem(:,:,jk-1) - ptem(:,:,jk) )      & 
    549                &                  - rbeta  * ( psal(:,:,jk-1) - psal(:,:,jk) )  )   & 
     536            pn2(:,:,jk) = grav * (  rn_alpha * ( ptem(:,:,jk-1) - ptem(:,:,jk) )      & 
     537               &                  - rn_beta  * ( psal(:,:,jk-1) - psal(:,:,jk) )  )   & 
    550538               &               / fse3w(:,:,jk) * tmask(:,:,jk) 
    551539         END DO  
    … …  
    561549         END DO 
    562550#endif 
    563          ! 
    564       CASE DEFAULT 
    565          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    566          CALL ctl_stop( ctmp1 ) 
    567          ! 
    568551      END SELECT 
    569552 
    … …  
    606589      !! ** Method  :   Read the namelist nameos and control the parameters 
    607590      !!---------------------------------------------------------------------- 
    608       NAMELIST/nameos/ neos, ralpha, rbeta 
     591      NAMELIST/nameos/ nn_eos, rn_alpha, rn_beta 
    609592      !!---------------------------------------------------------------------- 
    610593      ! 
    … …  
    617600         WRITE(numout,*) '~~~~~~~~' 
    618601         WRITE(numout,*) '          Namelist nameos : set eos parameters' 
    619          WRITE(numout,*) '             flag for eq. of state and N^2  neos   = ', neos 
    620          WRITE(numout,*) '             thermal exp. coef. (linear)    ralpha = ', ralpha 
    621          WRITE(numout,*) '             saline  exp. coef. (linear)    rbeta  = ', rbeta 
     602         WRITE(numout,*) '             flag for eq. of state and N^2  nn_eos   = ', nn_eos 
     603         WRITE(numout,*) '             thermal exp. coef. (linear)    rn_alpha = ', rn_alpha 
     604         WRITE(numout,*) '             saline  exp. coef. (linear)    rn_beta  = ', rn_beta 
    622605      ENDIF 
    623606      ! 
    624       SELECT CASE( neos ) 
    625       ! 
    626       CASE( 0 )                   !==  Jackett and McDougall (1994) formulation  ==! 
     607      SELECT CASE( nn_eos )         ! check option 
     608      ! 
     609      CASE( 0 )                        !==  Jackett and McDougall (1994) formulation  ==! 
    627610         IF(lwp) WRITE(numout,*) 
    628611         IF(lwp) WRITE(numout,*) '          use of Jackett & McDougall (1994) equation of state and' 
    629612         IF(lwp) WRITE(numout,*) '                 McDougall (1987) Brunt-Vaisala frequency' 
    630613         ! 
    631       CASE( 1 )                   !==  Linear formulation = F( temperature )  ==! 
     614      CASE( 1 )                        !==  Linear formulation = F( temperature )  ==! 
    632615         IF(lwp) WRITE(numout,*) 
    633          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )' 
     616         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T) = rau0 * ( 1.0285 - rn_alpha * T )' 
    634617         IF( lk_zdfddm ) CALL ctl_stop( '          double diffusive mixing parameterization requires',   & 
    635618              &                         ' that T and S are used as state variables' ) 
    636619         ! 
    637       CASE( 2 )                   !==  Linear formulation = F( temperature , salinity )  ==! 
    638          ralpbet = ralpha / rbeta 
     620      CASE( 2 )                        !==  Linear formulation = F( temperature , salinity )  ==! 
     621         ralpbet = rn_alpha / rn_beta 
    639622         IF(lwp) WRITE(numout,*) 
    640          IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 
    641          ! 
    642       CASE DEFAULT                !==  ERROR in neos  ==! 
    643          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
     623         IF(lwp) WRITE(numout,*) '          use of linear eos rho(T,S) = rau0 * ( rn_beta * S - rn_alpha * T )' 
     624         ! 
     625      CASE DEFAULT                     !==  ERROR in nn_eos  ==! 
     626         WRITE(ctmp1,*) '          bad flag value for nn_eos = ', nn_eos 
    644627         CALL ctl_stop( ctmp1 ) 
    645628         ! 

  • trunk/NEMO/OPA_SRC/lib_cray.f90

    r1152 r1601  
    44!  check their existence 
    55!   
    6 !  sdot 
    76!  wheneq 
    8 !  saxpy 
    9 !  isrchne 
    10    !!---------------------------------------------------------------------- 
    11    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
    12    !! $Id$  
    13    !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    14    !!---------------------------------------------------------------------- 
    15 !--------------------------------------------------------- 
    16      FUNCTION sdot( I, X, J, Y, K ) 
    17         DIMENSION X(1), Y(1) 
    18         SDOT = 0. 
    19         DO N = 1, I 
    20         SDOT = SDOT + X(1+(N-1)*J) * Y(1+(N-1)*K) 
    21         END DO 
    22      END FUNCTION sdot 
    23 !--------------------------------------------------------- 
     7!!---------------------------------------------------------------------- 
     8!!  OPA 9.0 , LOCEAN-IPSL (2005)  
     9!! $Id$  
     10!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
     11!!---------------------------------------------------------------------- 
    2412     SUBROUTINE wheneq ( i, x, j, t, ind, nn ) 
    2513        IMPLICIT NONE 
    … …  
    4129 
    4230     END SUBROUTINE wheneq 
    43 !--------------------------------------------------------- 
    44      SUBROUTINE saxpy( I, A, X, J, Y, K ) 
    45         DIMENSION X(1),Y(1) 
    46         DO N = 1, I 
    47            Y(1+(N-1)*K)=A*X(1+(N-1)*J)+Y(1+(N-1)*K) 
    48         END DO 
    49      END SUBROUTINE saxpy 
    50 !--------------------------------------------------------- 
    51      FUNCTION isrchne( K, X, I, B ) 
    52         DIMENSION X(1) 
    53         DO N = 1, K 
    54            IF( X(1+(N-1)*I) /= B ) THEN 
    55               ISRCHNE = N 
    56               RETURN 
    57            ELSE 
    58               ISRCHNE = N + 1 
    59            ENDIF 
    60         END DO 
    61      END FUNCTION isrchne 

  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r1579 r1601  
    139139 
    140140   ! Type of send : standard, buffered, immediate 
    141    CHARACTER(len=1) ::   c_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    142    LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if c_mpi_send='I') 
     141   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
     142   LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
    143143   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend  
    144144       
    … …  
    177177      LOGICAL ::   mpi_was_called 
    178178       
    179       NAMELIST/nam_mpp/ c_mpi_send, nn_buffer 
     179      NAMELIST/nammpp/ cn_mpi_send, nn_buffer 
    180180      !!---------------------------------------------------------------------- 
    181181      ! 
    … …  
    183183      WRITE(ldtxt(2),*) 'mynode : mpi initialisation' 
    184184      WRITE(ldtxt(3),*) '~~~~~~ ' 
    185       WRITE(ldtxt(4),*) 
    186185      ! 
    187186      REWIND( numnam )               ! Namelist namrun : parameters of the run 
    188       READ  ( numnam, nam_mpp ) 
     187      READ  ( numnam, nammpp ) 
    189188      !                              ! control print 
    190       WRITE(ldtxt(5),*) '        Namelist nam_mpp' 
    191       WRITE(ldtxt(6),*) '           mpi send type            c_mpi_send = ', c_mpi_send 
     189      WRITE(ldtxt(4),*) '   Namelist nammpp' 
     190      WRITE(ldtxt(5),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send 
     191      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer 
    192192 
    193193#if defined key_agrif 
    … …  
    205205         IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
    206206            mpi_comm_opa = localComm 
    207             SELECT CASE ( c_mpi_send ) 
     207            SELECT CASE ( cn_mpi_send ) 
    208208            CASE ( 'S' )                ! Standard mpi send (blocking) 
    209209               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    … …  
    216216            CASE DEFAULT 
    217217               WRITE(ldtxt(7),cform_err) 
    218                WRITE(ldtxt(8),*) '           bad value for c_mpi_send = ', c_mpi_send 
     218               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    219219               nstop = nstop + 1 
    220220            END SELECT 
    … …  
    225225         ELSE 
    226226#endif 
    227             SELECT CASE ( c_mpi_send ) 
     227            SELECT CASE ( cn_mpi_send ) 
    228228            CASE ( 'S' )                ! Standard mpi send (blocking) 
    229229               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    … …  
    238238            CASE DEFAULT 
    239239               WRITE(ldtxt(7),cform_err) 
    240                WRITE(ldtxt(8),*) '           bad value for c_mpi_send = ', c_mpi_send 
     240               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    241241               nstop = nstop + 1 
    242242            END SELECT 
    … …  
    254254#if defined key_agrif 
    255255      ELSE 
    256          SELECT CASE ( c_mpi_send ) 
     256         SELECT CASE ( cn_mpi_send ) 
    257257         CASE ( 'S' )                ! Standard mpi send (blocking) 
    258258            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    … …  
    264264         CASE DEFAULT 
    265265            WRITE(ldtxt(7),cform_err) 
    266             WRITE(ldtxt(8),*) '           bad value for c_mpi_send = ', c_mpi_send 
     266            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    267267            nstop = nstop + 1 
    268268         END SELECT 
    … …  
    10441044      !!---------------------------------------------------------------------- 
    10451045      ! 
    1046       SELECT CASE ( c_mpi_send ) 
     1046      SELECT CASE ( cn_mpi_send ) 
    10471047      CASE ( 'S' )                ! Standard mpi send (blocking) 
    10481048         CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest , ktyp, mpi_comm_opa        , iflag ) 

  • trunk/NEMO/OPA_SRC/mppini_2.h90

    r1581 r1601  
    3939      !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
    4040      !!---------------------------------------------------------------------- 
    41       !! * Modules used 
    4241      USE in_out_manager  ! I/O Manager 
    4342      USE iom 
    44     
    45       !! Local variables 
     43      !!  
    4644      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices 
    4745      INTEGER ::  inum                        ! temporary logical unit 
    … …  
    7169 
    7270      ! read namelist for ln_zco 
    73       NAMELIST/nam_zgr/ ln_zco, ln_zps, ln_sco 
     71      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 
    7472 
    7573      !!---------------------------------------------------------------------- 
    … …  
    7876      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
    7977      !!---------------------------------------------------------------------- 
    80       ! Read Namelist nam_zgr : vertical coordinate' 
    81       ! --------------------- 
    82       REWIND ( numnam ) 
    83       READ   ( numnam, nam_zgr ) 
     78       
     79      REWIND ( numnam )              ! Read Namelist namzgr : vertical coordinate' 
     80      READ   ( numnam, namzgr ) 
    8481 
    8582      IF(lwp)WRITE(numout,*) 

  • trunk/NEMO/OPA_SRC/oce.F90

    r1528 r1601  
    1313   PRIVATE 
    1414 
    15    !! Physics and algorithm flags 
    16    !! --------------------------- 
    1715   LOGICAL, PUBLIC ::   l_traldf_rot    = .FALSE.  !: rotated laplacian operator for lateral diffusion 
    18    LOGICAL, PUBLIC ::   ln_dynhpg_imp   = .FALSE.  !: semi-implicite hpg flag 
    19    INTEGER, PUBLIC ::   nn_dynhpg_rst   = 0        !: add dynhpg implicit variables in restart ot not 
    2016 
    2117   !! dynamics and tracer fields             !  before  !  now     !  after   ! the after trends becomes the fields 

  • trunk/NEMO/OPA_SRC/opa.F90

    r1598 r1601  
    4747   USE istate          ! initial state setting          (istate_init routine) 
    4848   USE eosbn2          ! equation of state                 (eos_init routine) 
     49   USE dynhpg          ! hydrostatic pressure gradient 
    4950   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
    5051   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine) 
    … …  
    176177      INTEGER                         ::   ji   ! local loop indices 
    177178      !! 
    178       NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   & 
    179          &             isplt , jsplt , njctls, njctle, nbench, nbit_cmp 
     179      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
     180         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench, nn_bit_cmp 
    180181      !!---------------------------------------------------------------------- 
    181182      ! 
    … …  
    283284      !!              - Read in namilist namflg logical flags 
    284285      !!---------------------------------------------------------------------- 
    285       NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst 
    286       !!---------------------------------------------------------------------- 
    287  
    288       IF(lwp) THEN                ! Parameter print 
     286      NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   & 
     287         &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   & 
     288         &                 ln_dynhpg_imp, nn_dynhpg_rst 
     289      !!---------------------------------------------------------------------- 
     290 
     291      IF(lwp) THEN                 ! Parameter print 
    289292         WRITE(numout,*) 
    290293         WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 
    291294         WRITE(numout,*) '~~~~~~~ ' 
    292295         WRITE(numout,*) '   Namelist namctl' 
    293          WRITE(numout,*) '      run control (for debugging)     ln_ctl    = ', ln_ctl 
    294          WRITE(numout,*) '      level of print                  nprint    = ', nprint 
    295          WRITE(numout,*) '      Start i indice for SUM control  nictls    = ', nictls 
    296          WRITE(numout,*) '      End i indice for SUM control    nictle    = ', nictle 
    297          WRITE(numout,*) '      Start j indice for SUM control  njctls    = ', njctls 
    298          WRITE(numout,*) '      End j indice for SUM control    njctle    = ', njctle 
    299          WRITE(numout,*) '      number of proc. following i     isplt     = ', isplt 
    300          WRITE(numout,*) '      number of proc. following j     jsplt     = ', jsplt 
    301          WRITE(numout,*) '      benchmark parameter (0/1)       nbench    = ', nbench 
    302          WRITE(numout,*) '      bit comparison mode (0/1)       nbit_cmp  = ', nbit_cmp 
    303       ENDIF 
     296         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl 
     297         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
     298         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
     299         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
     300         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
     301         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
     302         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
     303         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
     304         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
     305         WRITE(numout,*) '      bit comparison mode (0/1)       nn_bit_cmp = ', nn_bit_cmp 
     306      ENDIF 
     307 
     308      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
     309      nictls    = nn_ictls 
     310      nictle    = nn_ictle 
     311      njctls    = nn_jctls 
     312      njctle    = nn_jctle 
     313      isplt     = nn_isplt 
     314      jsplt     = nn_jsplt 
     315      nbench    = nn_bench 
     316      nbit_cmp  = nn_bit_cmp 
    304317 
    305318      !                           ! Parameter control 
    … …  
    355368      ENDIF 
    356369 
    357  
    358       REWIND( numnam )            ! Read Namelist namflg : algorithm FLaG 
    359       READ  ( numnam, namflg ) 
    360  
    361       IF(lwp) THEN                ! Parameter print 
    362          WRITE(numout,*) 
    363          WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm' 
    364          WRITE(numout,*) '~~~~~~~' 
    365          WRITE(numout,*) '   Namelist namflg : hydrostatic pressure gradient time stepping' 
    366          WRITE(numout,*) '      centered (F) or semi-implicit (T)        ln_dynhpg_imp = ', ln_dynhpg_imp 
    367          WRITE(numout,*) '      ensure restartability (=1) or not (=0)   nn_dynhpg_rst = ', nn_dynhpg_rst 
    368       ENDIF 
    369       ! 
    370       IF( .NOT. ln_dynhpg_imp )   nn_dynhpg_rst = 0      ! force no adding dynhpg implicit variables in restart 
     370      REWIND( numnam )              ! Read Namelist namdyn_hpg : ln_dynhpg_imp must be read at the initialisation phase 
     371      READ  ( numnam, namdyn_hpg ) 
    371372      ! 
    372373   END SUBROUTINE opa_flg 
Note: See TracChangeset for help on using the changeset viewer.