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

Ignore:
Timestamp:
2015-06-29T14:37:35+02:00 (9 years ago)
Author:
cetlod
Message:

bugfix: computation of the meskmask from coordinate/bathymetry if needed in offline mode, see ticket #1545

Location:
trunk/NEMOGCM/NEMO/OFF_SRC
Files:
4 deleted
2 edited

Legend:

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

    r4990 r5504  
    11MODULE domrea 
    2    !!====================================================================== 
    3    !!                       ***  MODULE domrea  *** 
    4    !! Ocean initialization : read the ocean domain meshmask file(s) 
    5    !!====================================================================== 
    6    !! History :  3.3  ! 2010-05  (C. Ethe)  Full reorganization of the off-line 
     2   !!============================================================================== 
     3   !!                       ***  MODULE domrea   *** 
     4   !! Ocean initialization : domain initialization 
     5   !!============================================================================== 
     6 
    77   !!---------------------------------------------------------------------- 
    8  
     8   !!   dom_init       : initialize the space and time domain 
     9   !!   dom_nam        : read and contral domain namelists 
     10   !!   dom_ctl        : control print for the ocean domain 
    911   !!---------------------------------------------------------------------- 
    10    !!   dom_rea        : read mesh and mask file(s) 
    11    !!                    nmsh = 1  :   mesh_mask file 
    12    !!                         = 2  :   mesh and mask file 
    13    !!                         = 3  :   mesh_hgr, mesh_zgr and mask 
    14    !!---------------------------------------------------------------------- 
     12   !! * Modules used 
     13   USE oce             !  
    1514   USE dom_oce         ! ocean space and time domain 
    16    USE dommsk          ! domain: masks 
     15   USE phycst          ! physical constants 
     16   USE in_out_manager  ! I/O manager 
     17   USE lib_mpp         ! distributed memory computing library 
     18 
     19   USE domstp          ! domain: set the time-step 
     20 
    1721   USE lbclnk          ! lateral boundary condition - MPP exchanges 
    1822   USE trc_oce         ! shared ocean/biogeochemical variables 
    19    USE lib_mpp  
    20    USE in_out_manager 
    2123   USE wrk_nemo   
    22  
     24    
    2325   IMPLICIT NONE 
    2426   PRIVATE 
    2527 
    26    PUBLIC   dom_rea    ! routine called by inidom.F90 
    27   !! * Substitutions 
     28   !! * Routine accessibility 
     29   PUBLIC dom_rea       ! called by opa.F90 
     30 
     31   !! * Substitutions 
    2832#  include "domzgr_substitute.h90" 
     33#  include "vectopt_loop_substitute.h90" 
    2934   !!---------------------------------------------------------------------- 
    3035   !! NEMO/OFF 3.3 , NEMO Consortium (2010) 
    3136   !! $Id$ 
    32    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     37   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3338   !!---------------------------------------------------------------------- 
     39 
    3440CONTAINS 
    3541 
     
    3743      !!---------------------------------------------------------------------- 
    3844      !!                  ***  ROUTINE dom_rea  *** 
     45      !!                     
     46      !! ** Purpose :   Domain initialization. Call the routines that are  
     47      !!      required to create the arrays which define the space and time 
     48      !!      domain of the ocean model. 
     49      !! 
     50      !! ** Method  : 
     51      !!      - dom_stp: defined the model time step 
     52      !!      - dom_rea: read the meshmask file if nmsh=1 
     53      !! 
     54      !! History : 
     55      !!        !  90-10  (C. Levy - G. Madec)  Original code 
     56      !!        !  91-11  (G. Madec) 
     57      !!        !  92-01  (M. Imbard) insert time step initialization 
     58      !!        !  96-06  (G. Madec) generalized vertical coordinate  
     59      !!        !  97-02  (G. Madec) creation of domwri.F 
     60      !!        !  01-05  (E.Durand - G. Madec) insert closed sea 
     61      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module 
     62      !!---------------------------------------------------------------------- 
     63      !! * Local declarations 
     64      INTEGER ::   jk                ! dummy loop argument 
     65      INTEGER ::   iconf = 0         ! temporary integers 
     66      !!---------------------------------------------------------------------- 
     67 
     68      IF(lwp) THEN 
     69         WRITE(numout,*) 
     70         WRITE(numout,*) 'dom_init : domain initialization' 
     71         WRITE(numout,*) '~~~~~~~~' 
     72      ENDIF 
     73 
     74      CALL dom_nam      ! read namelist ( namrun, namdom, namcla ) 
     75      CALL dom_zgr      ! Vertical mesh and bathymetry option 
     76      CALL dom_grd      ! Create a domain file 
     77 
     78     ! 
     79      ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines 
     80      !        but could be usefull in many other routines 
     81      e12t    (:,:) = e1t(:,:) * e2t(:,:) 
     82      e1e2t   (:,:) = e1t(:,:) * e2t(:,:) 
     83      e12u    (:,:) = e1u(:,:) * e2u(:,:) 
     84      e12v    (:,:) = e1v(:,:) * e2v(:,:) 
     85      e12f    (:,:) = e1f(:,:) * e2f(:,:) 
     86      r1_e12t (:,:) = 1._wp    / e12t(:,:) 
     87      r1_e12u (:,:) = 1._wp    / e12u(:,:) 
     88      r1_e12v (:,:) = 1._wp    / e12v(:,:) 
     89      r1_e12f (:,:) = 1._wp    / e12f(:,:) 
     90      re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 
     91      re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 
     92      ! 
     93      hu(:,:) = 0._wp                          ! Ocean depth at U- and V-points 
     94      hv(:,:) = 0._wp 
     95      DO jk = 1, jpk 
     96         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 
     97         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 
     98      END DO 
     99      !                                        ! Inverse of the local depth 
     100      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 
     101      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 
     102 
     103      CALL dom_stp      ! Time step 
     104      CALL dom_msk      ! Masks 
     105      CALL dom_ctl      ! Domain control 
     106 
     107   END SUBROUTINE dom_rea 
     108 
     109   SUBROUTINE dom_nam 
     110      !!---------------------------------------------------------------------- 
     111      !!                     ***  ROUTINE dom_nam  *** 
     112      !!                     
     113      !! ** Purpose :   read domaine namelists and print the variables. 
     114      !! 
     115      !! ** input   : - namrun namelist 
     116      !!              - namdom namelist 
     117      !!              - namcla namelist 
     118      !!---------------------------------------------------------------------- 
     119      USE ioipsl 
     120      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     121      NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list,               & 
     122         &             nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   & 
     123         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
     124         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler 
     125      NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   & 
     126         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            & 
     127         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea , ln_crs, & 
     128         &             jphgr_msh, & 
     129         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, & 
     130         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, & 
     131         &             ppa2, ppkth2, ppacr2 
     132      NAMELIST/namcla/ nn_cla 
     133#if defined key_netcdf4 
     134      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip 
     135#endif 
     136      !!---------------------------------------------------------------------- 
     137 
     138      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
     139      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
     140901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp ) 
     141 
     142      REWIND( numnam_cfg )              ! Namelist namrun in configuration namelist : Parameters of the run 
     143      READ  ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 ) 
     144902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp ) 
     145      IF(lwm) WRITE ( numond, namrun ) 
     146      ! 
     147      IF(lwp) THEN                  ! control print 
     148         WRITE(numout,*) 
     149         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read' 
     150         WRITE(numout,*) '~~~~~~~ ' 
     151         WRITE(numout,*) '   Namelist namrun'   
     152         WRITE(numout,*) '      job number                      nn_no      = ', nn_no 
     153         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp 
     154         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart 
     155         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl 
     156         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000 
     157         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend 
     158         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0 
     159         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy 
     160         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate 
     161         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock 
     162         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write 
     163         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn 
     164         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland 
     165         WRITE(numout,*) '      additional CF standard metadata ln_cfmeta  = ', ln_cfmeta 
     166         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber 
     167         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
     168      ENDIF 
     169      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon) 
     170      cexper = cn_exp 
     171      nrstdt = nn_rstctl 
     172      nit000 = nn_it000 
     173      nitend = nn_itend 
     174      ndate0 = nn_date0 
     175      nleapy = nn_leapy 
     176      ninist = nn_istate 
     177      nstock = nn_stock 
     178      nstocklist = nn_stocklist 
     179      nwrite = nn_write 
     180 
     181 
     182      !                             ! control of output frequency 
     183      IF ( nstock == 0 .OR. nstock > nitend ) THEN 
     184         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend 
     185         CALL ctl_warn( ctmp1 ) 
     186         nstock = nitend 
     187      ENDIF 
     188      IF ( nwrite == 0 ) THEN 
     189         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend 
     190         CALL ctl_warn( ctmp1 ) 
     191         nwrite = nitend 
     192      ENDIF 
     193 
     194      ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 
     195      ndastp = ndate0 - 1        ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 
     196      adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     197 
     198#if defined key_agrif 
     199      IF( Agrif_Root() ) THEN 
     200#endif 
     201      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     202      CASE (  1 )  
     203         CALL ioconf_calendar('gregorian') 
     204         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
     205      CASE (  0 ) 
     206         CALL ioconf_calendar('noleap') 
     207         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
     208      CASE ( 30 ) 
     209         CALL ioconf_calendar('360d') 
     210         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     211      END SELECT 
     212#if defined key_agrif 
     213      ENDIF 
     214#endif 
     215 
     216      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep) 
     217      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
     218903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp ) 
     219 
     220      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep) 
     221      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 ) 
     222904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp ) 
     223      IF(lwm) WRITE ( numond, namdom ) 
     224 
     225      IF(lwp) THEN 
     226         WRITE(numout,*)  
     227         WRITE(numout,*) '   Namelist namdom : space & time domain' 
     228         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy 
     229         WRITE(numout,*) '      Depth (if =0 bathy=jpkm1)         rn_bathy     = ', rn_bathy 
     230         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin 
     231         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)' 
     232         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat 
     233         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh 
     234         WRITE(numout,*) '           = 0   no file created                 ' 
     235         WRITE(numout,*) '           = 1   mesh_mask                       ' 
     236         WRITE(numout,*) '           = 2   mesh and mask                   ' 
     237         WRITE(numout,*) '           = 3   mesh_hgr, msh_zgr and mask      ' 
     238         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt 
     239         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp 
     240         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro 
     241         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc 
     242         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin 
     243         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax 
     244         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth 
     245         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea 
     246         WRITE(numout,*) '      type of horizontal mesh jphgr_msh           = ', jphgr_msh 
     247         WRITE(numout,*) '      longitude of first raw and column T-point ppglam0 = ', ppglam0 
     248         WRITE(numout,*) '      latitude  of first raw and column T-point ppgphi0 = ', ppgphi0 
     249         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_deg        = ', ppe1_deg 
     250         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_deg        = ', ppe2_deg 
     251         WRITE(numout,*) '      zonal      grid-spacing (degrees) ppe1_m          = ', ppe1_m 
     252         WRITE(numout,*) '      meridional grid-spacing (degrees) ppe2_m          = ', ppe2_m 
     253         WRITE(numout,*) '      ORCA r4, r2 and r05 coefficients  ppsur           = ', ppsur 
     254         WRITE(numout,*) '                                        ppa0            = ', ppa0 
     255         WRITE(numout,*) '                                        ppa1            = ', ppa1 
     256         WRITE(numout,*) '                                        ppkth           = ', ppkth 
     257         WRITE(numout,*) '                                        ppacr           = ', ppacr 
     258         WRITE(numout,*) '      Minimum vertical spacing ppdzmin                  = ', ppdzmin 
     259         WRITE(numout,*) '      Maximum depth pphmax                              = ', pphmax 
     260         WRITE(numout,*) '      Use double tanf function for vertical coordinates ldbletanh = ', ldbletanh 
     261         WRITE(numout,*) '      Double tanh function parameters ppa2              = ', ppa2 
     262         WRITE(numout,*) '                                      ppkth2            = ', ppkth2 
     263         WRITE(numout,*) '                                      ppacr2            = ', ppacr2 
     264      ENDIF 
     265 
     266      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon) 
     267      e3zps_min = rn_e3zps_min 
     268      e3zps_rat = rn_e3zps_rat 
     269      nmsh      = nn_msh 
     270      nacc      = nn_acc 
     271      atfp      = rn_atfp 
     272      rdt       = rn_rdt 
     273      rdtmin    = rn_rdtmin 
     274      rdtmax    = rn_rdtmin 
     275      rdth      = rn_rdth 
     276 
     277      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection 
     278      READ  ( numnam_ref, namcla, IOSTAT = ios, ERR = 905) 
     279905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in reference namelist', lwp ) 
     280 
     281      REWIND( numnam_cfg )              ! Namelist namcla in configuration namelist : Cross land advection 
     282      READ  ( numnam_cfg, namcla, IOSTAT = ios, ERR = 906 ) 
     283906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcla in configuration namelist', lwp ) 
     284      IF(lwm) WRITE( numond, namcla ) 
     285 
     286      IF(lwp) THEN 
     287         WRITE(numout,*) 
     288         WRITE(numout,*) '   Namelist namcla' 
     289         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla 
     290      ENDIF 
     291 
     292#if defined key_netcdf4 
     293      !                             ! NetCDF 4 case   ("key_netcdf4" defined) 
     294      REWIND( numnam_ref )              ! Namelist namnc4 in reference namelist : NETCDF 
     295      READ  ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907) 
     296907   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp ) 
     297 
     298      REWIND( numnam_cfg )              ! Namelist namnc4 in configuration namelist : NETCDF 
     299      READ  ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 ) 
     300908   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp ) 
     301      IF(lwm) WRITE( numond, namnc4 ) 
     302      IF(lwp) THEN                        ! control print 
     303         WRITE(numout,*) 
     304         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters' 
     305         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i 
     306         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j 
     307         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k 
     308         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip 
     309      ENDIF 
     310 
     311      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module) 
     312      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1 
     313      snc4set%ni   = nn_nchunks_i 
     314      snc4set%nj   = nn_nchunks_j 
     315      snc4set%nk   = nn_nchunks_k 
     316      snc4set%luse = ln_nc4zip 
     317#else 
     318      snc4set%luse = .FALSE.        ! No NetCDF 4 case 
     319#endif 
     320      ! 
     321   END SUBROUTINE dom_nam 
     322 
     323   SUBROUTINE dom_zgr 
     324      !!---------------------------------------------------------------------- 
     325      !!                ***  ROUTINE dom_zgr  *** 
     326      !!                    
     327      !! ** Purpose :  set the depth of model levels and the resulting  
     328      !!      vertical scale factors. 
     329      !! 
     330      !! ** Method  : - reference 1D vertical coordinate (gdep._1d, e3._1d) 
     331      !!              - read/set ocean depth and ocean levels (bathy, mbathy) 
     332      !!              - vertical coordinate (gdep., e3.) depending on the  
     333      !!                coordinate chosen : 
     334      !!                   ln_zco=T   z-coordinate   
     335      !!                   ln_zps=T   z-coordinate with partial steps 
     336      !!                   ln_zco=T   s-coordinate  
     337      !! 
     338      !! ** Action  :   define gdep., e3., mbathy and bathy 
     339      !!---------------------------------------------------------------------- 
     340      INTEGER ::   ioptio = 0   ! temporary integer 
     341      INTEGER ::   ios 
     342      !! 
     343      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
     344      !!---------------------------------------------------------------------- 
     345 
     346      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate 
     347      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 ) 
     348901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 
     349 
     350      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate 
     351      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
     352902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
     353      IF(lwm) WRITE ( numond, namzgr ) 
     354 
     355      IF(lwp) THEN                     ! Control print 
     356         WRITE(numout,*) 
     357         WRITE(numout,*) 'dom_zgr : vertical coordinate' 
     358         WRITE(numout,*) '~~~~~~~' 
     359         WRITE(numout,*) '          Namelist namzgr : set vertical coordinate' 
     360         WRITE(numout,*) '             z-coordinate - full steps      ln_zco    = ', ln_zco 
     361         WRITE(numout,*) '             z-coordinate - partial steps   ln_zps    = ', ln_zps 
     362         WRITE(numout,*) '             s- or hybrid z-s-coordinate    ln_sco    = ', ln_sco 
     363         WRITE(numout,*) '             ice shelf cavity               ln_isfcav = ', ln_isfcav 
     364      ENDIF 
     365 
     366      ioptio = 0                       ! Check Vertical coordinate options 
     367      IF( ln_zco ) ioptio = ioptio + 1 
     368      IF( ln_zps ) ioptio = ioptio + 1 
     369      IF( ln_sco ) ioptio = ioptio + 1 
     370      IF( ln_isfcav ) ioptio = 33 
     371      IF ( ioptio /= 1  )   CALL ctl_stop( ' none or several vertical coordinate options used' ) 
     372      IF ( ioptio == 33 )   CALL ctl_stop( ' isf cavity with off line module not yet done    ' ) 
     373 
     374   END SUBROUTINE dom_zgr 
     375 
     376   SUBROUTINE dom_ctl 
     377      !!---------------------------------------------------------------------- 
     378      !!                     ***  ROUTINE dom_ctl  *** 
     379      !! 
     380      !! ** Purpose :   Domain control. 
     381      !! 
     382      !! ** Method  :   compute and print extrema of masked scale factors 
     383      !! 
     384      !! History : 
     385      !!   8.5  !  02-08  (G. Madec)    Original code 
     386      !!---------------------------------------------------------------------- 
     387      !! * Local declarations 
     388      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 
     389      INTEGER, DIMENSION(2) ::   iloc      !  
     390      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max 
     391      !!---------------------------------------------------------------------- 
     392 
     393      ! Extrema of the scale factors 
     394 
     395      IF(lwp)WRITE(numout,*) 
     396      IF(lwp)WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
     397      IF(lwp)WRITE(numout,*) '~~~~~~~' 
     398 
     399      IF (lk_mpp) THEN 
     400         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 ) 
     401         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 ) 
     402         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 ) 
     403         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 ) 
     404      ELSE 
     405         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     406         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     407         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     408         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )     
     409 
     410         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     411         iimi1 = iloc(1) + nimpp - 1 
     412         ijmi1 = iloc(2) + njmpp - 1 
     413         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     414         iimi2 = iloc(1) + nimpp - 1 
     415         ijmi2 = iloc(2) + njmpp - 1 
     416         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     417         iima1 = iloc(1) + nimpp - 1 
     418         ijma1 = iloc(2) + njmpp - 1 
     419         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 ) 
     420         iima2 = iloc(1) + nimpp - 1 
     421         ijma2 = iloc(2) + njmpp - 1 
     422      ENDIF 
     423 
     424      IF(lwp) THEN 
     425         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 
     426         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1 
     427         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2 
     428         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 
     429      ENDIF 
     430 
     431   END SUBROUTINE dom_ctl 
     432 
     433   SUBROUTINE dom_grd 
     434      !!---------------------------------------------------------------------- 
     435      !!                  ***  ROUTINE dom_grd  *** 
    39436      !!                    
    40437      !! ** Purpose :  Read the NetCDF file(s) which contain(s) all the 
     
    344741      CALL wrk_dealloc( jpi, jpj, zmbk, zprt, zprw ) 
    345742      ! 
    346    END SUBROUTINE dom_rea 
     743   END SUBROUTINE dom_grd 
    347744 
    348745 
     
    388785   END SUBROUTINE zgr_bot_level 
    389786 
     787   SUBROUTINE dom_msk 
     788      !!--------------------------------------------------------------------- 
     789      !!                 ***  ROUTINE dom_msk  *** 
     790      !! 
     791      !! ** Purpose :   Off-line case: defines the interior domain T-mask. 
     792      !! 
     793      !! ** Method  :   The interior ocean/land mask is computed from tmask 
     794      !!              setting to zero the duplicated row and lines due to 
     795      !!              MPP exchange halos, est-west cyclic and north fold 
     796      !!              boundary conditions. 
     797      !! 
     798      !! ** Action :   tmask_i  : interiorland/ocean mask at t-point 
     799      !!               tpol     : ??? 
     800      !!---------------------------------------------------------------------- 
     801      ! 
     802      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
     803      INTEGER  ::   iif, iil, ijf, ijl       ! local integers 
     804      INTEGER, POINTER, DIMENSION(:,:) ::  imsk  
     805      ! 
     806      !!--------------------------------------------------------------------- 
     807       
     808      CALL wrk_alloc( jpi, jpj, imsk ) 
     809      ! 
     810      ! Interior domain mask (used for global sum) 
     811      ! -------------------- 
     812      ssmask(:,:)  = tmask(:,:,1) 
     813      tmask_i(:,:) = tmask(:,:,1) 
     814      iif = jpreci                        ! thickness of exchange halos in i-axis 
     815      iil = nlci - jpreci + 1 
     816      ijf = jprecj                        ! thickness of exchange halos in j-axis 
     817      ijl = nlcj - jprecj + 1 
     818      ! 
     819      tmask_i( 1 :iif,   :   ) = 0._wp    ! first columns 
     820      tmask_i(iil:jpi,   :   ) = 0._wp    ! last  columns (including mpp extra columns) 
     821      tmask_i(   :   , 1 :ijf) = 0._wp    ! first rows 
     822      tmask_i(   :   ,ijl:jpj) = 0._wp    ! last  rows (including mpp extra rows) 
     823      ! 
     824      !                                   ! north fold mask 
     825      tpol(1:jpiglo) = 1._wp 
     826      !                                 
     827      IF( jperio == 3 .OR. jperio == 4 )   tpol(jpiglo/2+1:jpiglo) = 0._wp    ! T-point pivot 
     828      IF( jperio == 5 .OR. jperio == 6 )   tpol(     1    :jpiglo) = 0._wp    ! F-point pivot 
     829      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot: only half of the nlcj-1 row 
     830         IF( mjg(ijl-1) == jpjglo-1 ) THEN 
     831            DO ji = iif+1, iil-1 
     832               tmask_i(ji,ijl-1) = tmask_i(ji,ijl-1) * tpol(mig(ji)) 
     833            END DO 
     834         ENDIF 
     835      ENDIF  
     836      ! 
     837      ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at 
     838      ! least 1 wet u point 
     839      DO jj = 1, jpjm1 
     840         DO ji = 1, fs_jpim1   ! vector loop 
     841            umask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
     842            vmask_i(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
     843         END DO 
     844         DO ji = 1, jpim1      ! NO vector opt. 
     845            fmask_i(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
     846               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
     847         END DO 
     848      END DO 
     849      CALL lbc_lnk( umask_i, 'U', 1._wp )      ! Lateral boundary conditions 
     850      CALL lbc_lnk( vmask_i, 'V', 1._wp ) 
     851      CALL lbc_lnk( fmask_i, 'F', 1._wp ) 
     852 
     853      ! 3. Ocean/land mask at wu-, wv- and w points  
     854      !---------------------------------------------- 
     855      wmask (:,:,1) = tmask(:,:,1) ! ???????? 
     856      wumask(:,:,1) = umask(:,:,1) ! ???????? 
     857      wvmask(:,:,1) = vmask(:,:,1) ! ???????? 
     858      DO jk=2,jpk 
     859         wmask (:,:,jk)=tmask(:,:,jk) * tmask(:,:,jk-1) 
     860         wumask(:,:,jk)=umask(:,:,jk) * umask(:,:,jk-1)    
     861         wvmask(:,:,jk)=vmask(:,:,jk) * vmask(:,:,jk-1) 
     862      END DO 
     863      ! 
     864      IF( nprint == 1 .AND. lwp ) THEN    ! Control print 
     865         imsk(:,:) = INT( tmask_i(:,:) ) 
     866         WRITE(numout,*) ' tmask_i : ' 
     867         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
     868         WRITE (numout,*) 
     869         WRITE (numout,*) ' dommsk: tmask for each level' 
     870         WRITE (numout,*) ' ----------------------------' 
     871         DO jk = 1, jpk 
     872            imsk(:,:) = INT( tmask(:,:,jk) ) 
     873            WRITE(numout,*) 
     874            WRITE(numout,*) ' level = ',jk 
     875            CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1, 1, jpj, 1, 1, numout) 
     876         END DO 
     877      ENDIF 
     878      ! 
     879      CALL wrk_dealloc( jpi, jpj, imsk ) 
     880      ! 
     881   END SUBROUTINE dom_msk 
     882 
    390883   !!====================================================================== 
    391884END MODULE domrea 
     885 
  • trunk/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

    r5407 r5504  
    1818   USE c1d             ! 1D configuration 
    1919   USE domcfg          ! domain configuration               (dom_cfg routine) 
    20    USE domain          ! domain initialization             (dom_init routine) 
    21    USE istate          ! initial state setting          (istate_init routine) 
     20   USE domain          ! domain initialization from coordinate & bathymetry (dom_init routine) 
     21   USE domrea          ! domain initialization from mesh_mask            (dom_init routine) 
    2222   USE eosbn2          ! equation of state            (eos bn2 routine) 
    2323   !              ! ocean physics 
     
    3434   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
    3535   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
    36    USE stpctl          ! time stepping control            (stp_ctl routine) 
    3736   !              ! I/O & MPP 
    3837   USE iom             ! I/O library 
     
    9594      istp = nit000 
    9695      !  
    97       CALL iom_init( "nemo" )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
     96      CALL iom_init( cxios_context )            ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 
    9897      !  
    9998      DO WHILE ( istp <= nitend .AND. nstop == 0 )    ! time stepping 
     
    108107      END DO 
    109108#if defined key_iomput 
    110       CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 
     109      CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 
    111110#endif 
    112111 
     
    143142      INTEGER ::   ilocal_comm   ! local integer 
    144143      INTEGER ::   ios 
     144      LOGICAL ::   llexist 
    145145      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    146146      !! 
     
    182182      !                             !--------------------------------------------! 
    183183#if defined key_iomput 
    184       CALL  xios_initialize( "nemo",return_comm=ilocal_comm ) 
     184      CALL  xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) 
    185185      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection 
    186186#else 
     
    269269      IF( lk_c1d        )   CALL     c1d_init   ! 1D column configuration 
    270270                            CALL     dom_cfg    ! Domain configuration 
    271                             CALL     dom_init   ! Domain 
     271      ! 
     272      INQUIRE( FILE='coordinates.nc', EXIST = llexist )   ! Check if coordinate file exist 
     273      ! 
     274      IF( llexist )  THEN  ;  CALL  dom_init   !  compute the grid from coordinates and bathymetry 
     275      ELSE                 ;  CALL  dom_rea    !  read grid from the meskmask 
     276      ENDIF 
    272277                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
    273278 
     
    276281      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control 
    277282 
    278       !                                     ! Ocean physics 
    279283                            CALL     sbc_init   ! Forcings : surface module 
     284 
    280285#if ! defined key_degrad 
    281286                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
     
    283288      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing 
    284289 
    285       !                                     ! Active tracers 
    286290                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    287291      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    288292 
    289                             CALL trc_nam_run  ! Needed to get restart parameters for passive tracers 
    290       IF( ln_rsttr ) THEN 
    291         neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
    292         CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    293       ELSE 
    294         neuler = 0                  ! Set time-step indicator at nit000 (euler) 
    295         CALL day_init               ! set calendar 
    296       ENDIF 
    297       !                                     ! Dynamics 
     293                            CALL trc_nam_run    ! Needed to get restart parameters for passive tracers 
     294                            CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    298295                            CALL dta_dyn_init   ! Initialization for the dynamics 
    299296 
    300       !                                     ! Passive tracers 
    301297                            CALL     trc_init   ! Passive tracers initialization 
    302       ! 
    303       ! Initialise diaptr as some variables are used in if statements later (in 
    304       ! various advection and diffusion routines. 
    305                             CALL dia_ptr_init 
    306       ! 
    307       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     298                            CALL dia_ptr_init   ! Initialise diaptr as some variables are used  
     299      !                                         ! in various advection and diffusion routines 
     300      IF(lwp) WRITE(numout,cform_aaa)           ! Flag AAAAAAA 
    308301      ! 
    309302      IF( nn_timing == 1 )  CALL timing_stop( 'nemo_init') 
     
    660653   END SUBROUTINE nemo_northcomms 
    661654#endif 
     655 
     656   SUBROUTINE istate_init 
     657      !!---------------------------------------------------------------------- 
     658      !!                   ***  ROUTINE istate_init  *** 
     659      !! 
     660      !! ** Purpose :   Initialization to zero of the dynamics and tracers. 
     661      !!---------------------------------------------------------------------- 
     662      ! 
     663      !     now fields         !     after fields      ! 
     664      un   (:,:,:)   = 0._wp   ;   ua(:,:,:) = 0._wp   ! 
     665      vn   (:,:,:)   = 0._wp   ;   va(:,:,:) = 0._wp   ! 
     666      wn   (:,:,:)   = 0._wp   !                       ! 
     667      hdivn(:,:,:)   = 0._wp   !                       ! 
     668      tsn  (:,:,:,:) = 0._wp   !                       ! 
     669      ! 
     670      rhd  (:,:,:) = 0.e0 
     671      rhop (:,:,:) = 0.e0 
     672      rn2  (:,:,:) = 0.e0 
     673      ! 
     674   END SUBROUTINE istate_init 
     675 
     676   SUBROUTINE stp_ctl( kt, kindic ) 
     677      !!---------------------------------------------------------------------- 
     678      !!                    ***  ROUTINE stp_ctl  *** 
     679      !! 
     680      !! ** Purpose :   Control the run 
     681      !! 
     682      !! ** Method  : - Save the time step in numstp 
     683      !! 
     684      !! ** Actions :   'time.step' file containing the last ocean time-step 
     685      !!---------------------------------------------------------------------- 
     686      INTEGER, INTENT(in   ) ::   kt      ! ocean time-step index 
     687      INTEGER, INTENT(inout) ::   kindic  ! indicator of solver convergence 
     688      !!---------------------------------------------------------------------- 
     689      ! 
     690      IF( kt == nit000 .AND. lwp ) THEN 
     691         WRITE(numout,*) 
     692         WRITE(numout,*) 'stp_ctl : time-stepping control' 
     693         WRITE(numout,*) '~~~~~~~' 
     694         ! open time.step file 
     695         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
     696      ENDIF 
     697      ! 
     698      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
     699      IF(lwp) REWIND( numstp )                       ! -------------------------- 
     700      ! 
     701   END SUBROUTINE stp_ctl 
    662702   !!====================================================================== 
    663703END MODULE nemogcm 
Note: See TracChangeset for help on using the changeset viewer.