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.
domain.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 4400

Last change on this file since 4400 was 3837, checked in by trackstand2, 11 years ago

Merge of finiss

  • Property svn:keywords set to Id
File size: 16.3 KB
RevLine 
[3]1MODULE domain
2   !!==============================================================================
3   !!                       ***  MODULE domain   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
[1438]6   !! History :  OPA  !  1990-10  (C. Levy - G. Madec)  Original code
7   !!                 !  1992-01  (M. Imbard) insert time step initialization
8   !!                 !  1996-06  (G. Madec) generalized vertical coordinate
9   !!                 !  1997-02  (G. Madec) creation of domwri.F
10   !!                 !  2001-05  (E.Durand - G. Madec) insert closed sea
11   !!   NEMO     1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
[2528]13   !!            3.3  !  2010-11  (G. Madec)  initialisation in C1D configuration
[3]14   !!----------------------------------------------------------------------
[1438]15   
16   !!----------------------------------------------------------------------
[3]17   !!   dom_init       : initialize the space and time domain
18   !!   dom_nam        : read and contral domain namelists
19   !!   dom_ctl        : control print for the ocean domain
20   !!----------------------------------------------------------------------
[2528]21   USE oce             ! ocean variables
22   USE dom_oce         ! domain: ocean
[888]23   USE sbc_oce         ! surface boundary condition: ocean
[719]24   USE phycst          ! physical constants
[1601]25   USE closea          ! closed seas
[719]26   USE in_out_manager  ! I/O manager
[3]27   USE lib_mpp         ! distributed memory computing library
28
29   USE domhgr          ! domain: set the horizontal mesh
30   USE domzgr          ! domain: set the vertical mesh
31   USE domstp          ! domain: set the time-step
32   USE dommsk          ! domain: set the mask system
33   USE domwri          ! domain: write the meshmask file
[592]34   USE domvvl          ! variable volume
[2528]35   USE c1d             ! 1D vertical configuration
36   USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
[3]37
38   IMPLICIT NONE
39   PRIVATE
40
[1438]41   PUBLIC   dom_init   ! called by opa.F90
[3837]42   PUBLIC   dom_nam    ! called by nemogcm::recursive_partition
[3]43
[3211]44   !! * Control permutation of array indices
45#  include "oce_ftrans.h90"
46#  include "dom_oce_ftrans.h90"
47#  include "sbc_oce_ftrans.h90"
48#  include "domvvl_ftrans.h90"
49
[3]50   !! * Substitutions
51#  include "domzgr_substitute.h90"
[1438]52   !!-------------------------------------------------------------------------
[2528]53   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[888]54   !! $Id$
[2528]55   !! Software governed by the CeCILL licence        (NEMOGCM/NEMO_CeCILL.txt)
[1438]56   !!-------------------------------------------------------------------------
[3]57CONTAINS
58
59   SUBROUTINE dom_init
60      !!----------------------------------------------------------------------
61      !!                  ***  ROUTINE dom_init  ***
62      !!                   
63      !! ** Purpose :   Domain initialization. Call the routines that are
[1601]64      !!              required to create the arrays which define the space
65      !!              and time domain of the ocean model.
[3]66      !!
[1601]67      !! ** Method  : - dom_msk: compute the masks from the bathymetry file
68      !!              - dom_hgr: compute or read the horizontal grid-point position
69      !!                         and scale factors, and the coriolis factor
70      !!              - dom_zgr: define the vertical coordinate and the bathymetry
71      !!              - dom_stp: defined the model time step
72      !!              - dom_wri: create the meshmask file if nmsh=1
[2528]73      !!              - 1D configuration, move Coriolis, u and v at T-point
[3]74      !!----------------------------------------------------------------------
75      INTEGER ::   jk                ! dummy loop argument
76      INTEGER ::   iconf = 0         ! temporary integers
77      !!----------------------------------------------------------------------
[1601]78      !
[3]79      IF(lwp) THEN
80         WRITE(numout,*)
81         WRITE(numout,*) 'dom_init : domain initialization'
82         WRITE(numout,*) '~~~~~~~~'
83      ENDIF
[1601]84      !
85                             CALL dom_nam      ! read namelist ( namrun, namdom, namcla )
86                             CALL dom_clo      ! Closed seas and lake
87                             CALL dom_hgr      ! Horizontal mesh
88                             CALL dom_zgr      ! Vertical mesh and bathymetry
89                             CALL dom_msk      ! Masks
90      IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
91      !
[2528]92      IF( lk_c1d ) THEN                        ! 1D configuration
93         CALL cor_c1d                          ! Coriolis set at T-point
94         umask(:,:,:) = tmask(:,:,:)           ! U, V moved at T-point
95         vmask(:,:,:) = tmask(:,:,:)
[3211]96#if defined key_z_first
97         umask_1(:,:) = umask(:,:,1)
98         vmask_1(:,:) = vmask(:,:,1)
99#endif
[2528]100      END IF
101      !
[1601]102      hu(:,:) = 0.e0                           ! Ocean depth at U- and V-points
[1438]103      hv(:,:) = 0.e0
[3]104      DO jk = 1, jpk
105         hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
106         hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
107      END DO
[1601]108      !                                        ! Inverse of the local depth
[3211]109#if defined key_z_first
110      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask_1(:,:) ) * umask_1(:,:)
111      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask_1(:,:) ) * vmask_1(:,:)
112#else
[1601]113      hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
114      hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
[3211]115#endif
[216]116
[1601]117                             CALL dom_stp      ! time step
118      IF( nmsh /= 0      )   CALL dom_wri      ! Create a domain file
119      IF( .NOT.ln_rstart )   CALL dom_ctl      ! Domain control
[1438]120      !
[3]121   END SUBROUTINE dom_init
122
123
124   SUBROUTINE dom_nam
125      !!----------------------------------------------------------------------
126      !!                     ***  ROUTINE dom_nam  ***
127      !!                   
128      !! ** Purpose :   read domaine namelists and print the variables.
129      !!
130      !! ** input   : - namrun namelist
131      !!              - namdom namelist
132      !!              - namcla namelist
[2528]133      !!              - namnc4 namelist   ! "key_netcdf4" only
[3]134      !!----------------------------------------------------------------------
135      USE ioipsl
[1601]136      NAMELIST/namrun/ nn_no   , cn_exp    , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl,   &
137         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   &
138         &             nn_write, ln_dimgnnn, ln_mskland  , ln_clobber   , nn_chunksz
[2528]139      NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh    , rn_hmin,   &
140         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,            &
[1601]141         &             rn_rdtmax, rn_rdth     , nn_baro     , nn_closea
142      NAMELIST/namcla/ nn_cla
[2528]143#if defined key_netcdf4
144      NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
145#endif
[3]146      !!----------------------------------------------------------------------
147
[1601]148      REWIND( numnam )              ! Namelist namrun : parameters of the run
149      READ  ( numnam, namrun )
150      !
151      IF(lwp) THEN                  ! control print
[3]152         WRITE(numout,*)
153         WRITE(numout,*) 'dom_nam  : domain initialization through namelist read'
154         WRITE(numout,*) '~~~~~~~ '
[1601]155         WRITE(numout,*) '   Namelist namrun'
156         WRITE(numout,*) '      job number                      nn_no      = ', nn_no
157         WRITE(numout,*) '      experiment name for output      cn_exp     = ', cn_exp
158         WRITE(numout,*) '      restart logical                 ln_rstart  = ', ln_rstart
[1604]159         WRITE(numout,*) '      control of time step            nn_rstctl  = ', nn_rstctl
[1601]160         WRITE(numout,*) '      number of the first time step   nn_it000   = ', nn_it000
161         WRITE(numout,*) '      number of the last time step    nn_itend   = ', nn_itend
162         WRITE(numout,*) '      initial calendar date aammjj    nn_date0   = ', nn_date0
163         WRITE(numout,*) '      leap year calendar (0/1)        nn_leapy   = ', nn_leapy
164         WRITE(numout,*) '      initial state output            nn_istate  = ', nn_istate
165         WRITE(numout,*) '      frequency of restart file       nn_stock   = ', nn_stock
166         WRITE(numout,*) '      frequency of output file        nn_write   = ', nn_write
167         WRITE(numout,*) '      multi file dimgout              ln_dimgnnn = ', ln_dimgnnn
168         WRITE(numout,*) '      mask land points                ln_mskland = ', ln_mskland
169         WRITE(numout,*) '      overwrite an existing file      ln_clobber = ', ln_clobber
170         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz
[3]171      ENDIF
172
[1601]173      no = nn_no                    ! conversion DOCTOR names into model names (this should disappear soon)
174      cexper = cn_exp
175      nrstdt = nn_rstctl
176      nit000 = nn_it000
177      nitend = nn_itend
178      ndate0 = nn_date0
179      nleapy = nn_leapy
180      ninist = nn_istate
181      nstock = nn_stock
182      nwrite = nn_write
[3]183
[1601]184
185      !                             ! control of output frequency
[1335]186      IF ( nstock == 0 .OR. nstock > nitend ) THEN
[1601]187         WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
[783]188         CALL ctl_warn( ctmp1 )
[1335]189         nstock = nitend
[3]190      ENDIF
191      IF ( nwrite == 0 ) THEN
[1601]192         WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
[783]193         CALL ctl_warn( ctmp1 )
194         nwrite = nitend
[3]195      ENDIF
196
[2528]197#if defined key_agrif
[1601]198      IF( Agrif_Root() ) THEN
[2528]199#endif
200      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL
201      CASE (  1 ) 
202         CALL ioconf_calendar('gregorian')
203         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year'
204      CASE (  0 )
205         CALL ioconf_calendar('noleap')
206         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year'
207      CASE ( 30 )
208         CALL ioconf_calendar('360d')
209         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year'
210      END SELECT
211#if defined key_agrif
[1601]212      ENDIF
[2528]213#endif
[3]214
[2528]215      REWIND( numnam )              ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
[3]216      READ  ( numnam, namdom )
217
218      IF(lwp) THEN
[72]219         WRITE(numout,*)
[1601]220         WRITE(numout,*) '   Namelist namdom : space & time domain'
221         WRITE(numout,*) '      flag read/compute bathymetry      nn_bathy     = ', nn_bathy
[2528]222         WRITE(numout,*) '      min depth of the ocean    (>0) or    rn_hmin   = ', rn_hmin
223         WRITE(numout,*) '      min number of ocean level (<0)       '
[1601]224         WRITE(numout,*) '      minimum thickness of partial      rn_e3zps_min = ', rn_e3zps_min, ' (m)'
225         WRITE(numout,*) '         step level                     rn_e3zps_rat = ', rn_e3zps_rat
226         WRITE(numout,*) '      create mesh/mask file(s)          nn_msh       = ', nn_msh
[2528]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'
[1601]231         WRITE(numout,*) '      ocean time step                      rn_rdt    = ', rn_rdt
232         WRITE(numout,*) '      asselin time filter parameter        rn_atfp   = ', rn_atfp
233         WRITE(numout,*) '      time-splitting: nb of sub time-step  nn_baro   = ', nn_baro
234         WRITE(numout,*) '      acceleration of converge             nn_acc    = ', nn_acc
235         WRITE(numout,*) '        nn_acc=1: surface tracer rdt       rn_rdtmin = ', rn_rdtmin
236         WRITE(numout,*) '                  bottom  tracer rdt       rdtmax    = ', rn_rdtmax
237         WRITE(numout,*) '                  depth of transition      rn_rdth   = ', rn_rdth
238         WRITE(numout,*) '      suppression of closed seas (=0)      nn_closea = ', nn_closea
[223]239      ENDIF
240
[1601]241      ntopo     = nn_bathy          ! conversion DOCTOR names into model names (this should disappear soon)
242      e3zps_min = rn_e3zps_min
243      e3zps_rat = rn_e3zps_rat
244      nmsh      = nn_msh
245      nacc      = nn_acc
246      atfp      = rn_atfp
247      rdt       = rn_rdt
248      rdtmin    = rn_rdtmin
249      rdtmax    = rn_rdtmin
250      rdth      = rn_rdth
251      nclosea   = nn_closea
252
[2528]253      REWIND( numnam )              ! Namelist cross land advection
[3]254      READ  ( numnam, namcla )
255      IF(lwp) THEN
[72]256         WRITE(numout,*)
[1601]257         WRITE(numout,*) '   Namelist namcla'
258         WRITE(numout,*) '      cross land advection                 nn_cla    = ', nn_cla
[3]259      ENDIF
260
[2528]261#if defined key_netcdf4
262      !                             ! NetCDF 4 case   ("key_netcdf4" defined)
263      REWIND( numnam )                    ! Namelist namnc4 : netcdf4 chunking parameters
264      READ  ( numnam, namnc4 )
265      IF(lwp) THEN                        ! control print
266         WRITE(numout,*)
267         WRITE(numout,*) '   Namelist namnc4 - Netcdf4 chunking parameters'
268         WRITE(numout,*) '      number of chunks in i-dimension      nn_nchunks_i   = ', nn_nchunks_i
269         WRITE(numout,*) '      number of chunks in j-dimension      nn_nchunks_j   = ', nn_nchunks_j
270         WRITE(numout,*) '      number of chunks in k-dimension      nn_nchunks_k   = ', nn_nchunks_k
271         WRITE(numout,*) '      apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
272      ENDIF
[1601]273
[2528]274      ! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
275      ! Note the chunk size in the unlimited (time) dimension will be fixed at 1
276      snc4set%ni   = nn_nchunks_i
277      snc4set%nj   = nn_nchunks_j
278      snc4set%nk   = nn_nchunks_k
279      snc4set%luse = ln_nc4zip
280#else
281      snc4set%luse = .FALSE.        ! No NetCDF 4 case
282#endif
[1438]283      !
[3]284   END SUBROUTINE dom_nam
285
286
287   SUBROUTINE dom_ctl
288      !!----------------------------------------------------------------------
289      !!                     ***  ROUTINE dom_ctl  ***
290      !!
291      !! ** Purpose :   Domain control.
292      !!
293      !! ** Method  :   compute and print extrema of masked scale factors
294      !!----------------------------------------------------------------------
295      INTEGER ::   iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
[1601]296      INTEGER, DIMENSION(2) ::   iloc   !
[3]297      REAL(wp) ::   ze1min, ze1max, ze2min, ze2max
298      !!----------------------------------------------------------------------
[1601]299      !
300      IF(lk_mpp) THEN
[3211]301#if defined key_z_first
302         CALL mpp_minloc( e1t(:,:), tmask_1(:,:), ze1min, iimi1,ijmi1 )
303         CALL mpp_minloc( e2t(:,:), tmask_1(:,:), ze2min, iimi2,ijmi2 )
304         CALL mpp_maxloc( e1t(:,:), tmask_1(:,:), ze1max, iima1,ijma1 )
305         CALL mpp_maxloc( e2t(:,:), tmask_1(:,:), ze2max, iima2,ijma2 )
306#else
[181]307         CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
308         CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
309         CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
310         CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
[3211]311#endif
[181]312      ELSE
313         ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
314         ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
315         ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )   
316         ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )   
[32]317
[181]318         iloc  = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
319         iimi1 = iloc(1) + nimpp - 1
320         ijmi1 = iloc(2) + njmpp - 1
321         iloc  = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
322         iimi2 = iloc(1) + nimpp - 1
323         ijmi2 = iloc(2) + njmpp - 1
324         iloc  = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
325         iima1 = iloc(1) + nimpp - 1
326         ijma1 = iloc(2) + njmpp - 1
327         iloc  = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
328         iima2 = iloc(1) + nimpp - 1
329         ijma2 = iloc(2) + njmpp - 1
[32]330      ENDIF
[3]331      IF(lwp) THEN
[1601]332         WRITE(numout,*)
333         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
334         WRITE(numout,*) '~~~~~~~'
[181]335         WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
336         WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
337         WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
338         WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
[3]339      ENDIF
[1438]340      !
[3]341   END SUBROUTINE dom_ctl
342
343   !!======================================================================
344END MODULE domain
Note: See TracBrowser for help on using the repository browser.