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.
domcfg.F90 on Ticket #245 – Attachment – NEMO

Ticket #245: domcfg.F90

File domcfg.F90, 10.9 KB (added by nemo_user, 16 years ago)

Enhanced domcfg.F90 to correctly handle inputs for a 1d configuration

Line 
1MODULE domcfg
2   !!==============================================================================
3   !!                       ***  MODULE domcfg   ***
4   !! Ocean initialization : domain configuration initialization
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_cfg        : initialize the domain configuration
9   !!----------------------------------------------------------------------
10   !! * Modules used
11   USE dom_oce         ! ocean space and time domain
12   USE phycst          ! physical constants
13   USE in_out_manager  ! I/O manager
14   USE lib_mpp         ! distributed memory computing library
15   USE c1d             ! 1D configuration
16   USE solisl          ! ???
17
18   IMPLICIT NONE
19   PRIVATE
20
21   !! * Routine accessibility
22   PUBLIC dom_cfg        ! called by opa.F90
23   !!----------------------------------------------------------------------
24   !!   OPA 9.0 , LOCEAN-IPSL (2005)
25   !! $Id: domcfg.F90 1152 2008-06-26 14:11:13Z rblod $
26   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
27   !!----------------------------------------------------------------------
28
29CONTAINS
30
31   SUBROUTINE dom_cfg
32      !!----------------------------------------------------------------------
33      !!                  ***  ROUTINE dom_cfg  ***
34      !!                   
35      !! ** Purpose :   set the domain configuration
36      !!
37      !! ** Method  :
38      !!
39      !! History :
40      !!   9.0  !  03-09  (G. Madec)  Original code
41      !!----------------------------------------------------------------------
42      !! * Local declarations
43      INTEGER ::   iconf = 0         ! temporary integers
44      !!----------------------------------------------------------------------
45
46      IF(lwp) THEN
47         WRITE(numout,*)
48         WRITE(numout,*) 'dom_cfg : set the ocean configuration'
49         WRITE(numout,*) '~~~~~~~      ocean model configuration used :',   &
50            &                             ' cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg
51      ENDIF
52
53      ! Global domain boundary conditions
54      ! ---------------------------------
55      IF(lwp) THEN
56         WRITE(numout,*) '          global domain lateral boundaries'
57
58         IF( jperio == 0 ) WRITE(numout,*) '             jperio= 0, closed'
59         IF( jperio == 1 ) WRITE(numout,*) '             jperio= 1, cyclic east-west'
60         IF( jperio == 2 ) WRITE(numout,*) '             jperio= 2, equatorial symmetric'
61         IF( jperio == 3 ) WRITE(numout,*) '             jperio= 3, north fold with T-point pivot'
62         IF( jperio == 4 ) WRITE(numout,*) '             jperio= 4, cyclic east-west and',   &
63                                                                  ' north fold with T-point pivot'
64         IF( jperio == 5 ) WRITE(numout,*) '             jperio= 5, north fold with F-point pivot'
65         IF( jperio == 6 ) WRITE(numout,*) '             jperio= 6, cyclic east-west and',   &
66                                                                  ' north fold with F-point pivot'
67      ENDIF
68      IF( jperio <  0 .OR. jperio > 6 ) CALL ctl_stop( 'jperio is out of range' )
69
70      ! global domain versus zoom and/or local domain
71      ! ---------------------------------------------
72
73      CALL dom_glo 
74
75   END SUBROUTINE dom_cfg
76
77
78   SUBROUTINE dom_glo
79      !!----------------------------------------------------------------------
80      !!                     ***  ROUTINE dom_glo  ***
81      !!
82      !! ** Purpose :   initialization for global domain, zoom and local domain
83      !!
84      !! ** Method  :   
85      !!
86      !! ** Action  : - mig  , mjg :
87      !!              - mi0  , mi1   :
88      !!              - mj0, , mj1   :
89      !!
90      !! History :
91      !!   8.5  !  02-08  (G. Madec)    Original code
92      !!----------------------------------------------------------------------
93      !! * Local declarations
94      INTEGER ::   ji, jj            ! dummy loop argument
95      !!----------------------------------------------------------------------
96
97      ! Local domain
98      ! ============
99
100      ! local domain indices ==> data domain indices
101      DO ji = 1, jpi
102        mig(ji) = ji + jpizoom - 1 + nimpp - 1
103      END DO
104      DO jj = 1, jpj
105        mjg(jj) = jj + jpjzoom - 1 + njmpp - 1
106      END DO
107
108      ! data domain indices ==> local domain indices
109      ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
110      ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
111      DO ji = 1, jpidta
112        mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi+1 ) )
113        mi1(ji) = MAX( 0, MIN( ji - jpizoom + 1 - nimpp + 1, jpi   ) )
114      END DO
115      DO jj = 1, jpjdta
116        mj0(jj) = MAX( 1, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj+1 ) )
117        mj1(jj) = MAX( 0, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj   ) )
118      END DO
119
120      IF(lwp) THEN
121         WRITE(numout,*)
122         WRITE(numout,*) 'dom_glo : domain: data / local '
123         WRITE(numout,*) '~~~~~~~ '
124         WRITE(numout,*) '          data input domain    : jpidta = ', jpidta,   &
125            &                                            ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta
126         WRITE(numout,*) '          global or zoom domain: jpiglo = ', jpiglo,   &
127            &                                            ' jpjglo = ', jpjglo, ' jpk    = ', jpk
128         WRITE(numout,*) '          local domain         : jpi    = ', jpi   ,   &
129            &                                            ' jpj    = ', jpj   , ' jpk    = ', jpk
130         WRITE(numout,*)
131         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
132            &                                           ' jpjzoom = ', jpjzoom
133         WRITE(numout,*)
134         WRITE(numout,*) '          conversion local  ==> data i-index domain'
135         WRITE(numout,25)              (mig(ji),ji = 1,jpi)
136         WRITE(numout,*)
137         WRITE(numout,*) '          conversion data   ==> local  i-index domain'
138         WRITE(numout,*) '             starting index'
139         WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
140         WRITE(numout,*) '             ending index'
141         WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
142         WRITE(numout,*)
143         WRITE(numout,*) '          conversion local  ==> data j-index domain'
144         WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
145         WRITE(numout,*)
146         WRITE(numout,*) '          conversion data  ==> local j-index domain'
147         WRITE(numout,*) '             starting index'
148         WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
149         WRITE(numout,*) '             ending index'
150         WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
151      ENDIF
152 25   FORMAT( 100(10x,19i4,/) )
153
154      ! Zoom domain
155      ! ===========
156
157      ! zoom control
158      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   &
159          jpjglo + jpjzoom - 1  >  jpjdta      ) &
160          &   CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' )
161
162      ! set zoom flag
163      IF ( jpiglo < jpidta .OR. jpjglo < jpjdta )   lzoom = .TRUE.
164
165      ! set zoom type flags
166      IF( lzoom .AND. jpizoom /= 1 )   lzoom_w = .TRUE.                     !
167      IF( lzoom .AND. jpjzoom /= 1 )   lzoom_s = .TRUE.
168      IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta )   lzoom_e = .TRUE.
169      IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta )   lzoom_n = .TRUE.
170
171      IF(lwp) THEN
172         WRITE(numout,*)
173         WRITE(numout,*) '          zoom flags : '
174         WRITE(numout,*) '             lzoom   = ', lzoom  , ' (T = zoom, F = global )'
175         WRITE(numout,*) '             lzoom_e = ', lzoom_e, ' (T = forced closed east  boundary)'
176         WRITE(numout,*) '             lzoom_w = ', lzoom_w, ' (T = forced closed west  boundary)'
177         WRITE(numout,*) '             lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'
178         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'
179      ENDIF
180      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  )   &
181           &   CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' )
182      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  )   &
183           &   CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' )
184      IF(  lzoom  .AND.  lk_isl  ) CALL ctl_stop( ' key_islands and zoom are not allowed' )
185
186      ! Pre-defined arctic/antarctic zoom of ORCA configuration flag
187      IF( cp_cfg == "orca" ) THEN
188         SELECT CASE ( jp_cfg )
189         !                                        ! =======================
190         CASE ( 2 )                               !  ORCA_R2 configuration
191            !                                     ! =======================
192            IF(  jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
193               & jpizoom ==  21    .AND. jpjzoom ==  97         )   lzoom_arct = .TRUE.
194            IF(  jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
195               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
196            !                                     ! =======================
197         CASE ( 05 )                              !  ORCA_R05 configuration
198            !                                     ! =======================
199            IF(  jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
200               & jpizoom ==  81    .AND. jpjzoom == 301         )   lzoom_arct = .TRUE.
201            IF(  jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
202               & jpizoom ==   1    .AND. jpjzoom ==   1         )   lzoom_anta = .TRUE.
203         END SELECT
204         !
205         IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic/arctic zoom flags : '
206         IF(lwp) WRITE(numout,*) '             lzoom_arct = ', lzoom_arct, ' (T=   arctic zoom, F=global)'
207         IF(lwp) WRITE(numout,*) '             lzoom_anta = ', lzoom_anta, ' (T=antarctic zoom, F=global)'
208         !
209      ENDIF
210         !
211         ! The 1d configuration will not read the correct columns from full size restarts
212         ! or any other fields read using jpdom_global. nimpp and njmpp may be set to the
213         ! relevant offsets to rectify this. This is only safe in single processor mode but
214         ! that should always be the operating mode for a 1d configuration anyway. These
215         ! changes may break parts of the rigid-lid code (solisl) and the open boundary
216         ! code (obcini, obcdom, obcdta, obcrad, obcrst) but none of these are relevant to
217         ! a typical application of a 1d configuration.
218         !
219      IF ( lk_c1d .AND. .NOT. lk_mpp ) THEN     
220       nimpp = mig(1)
221       njmpp = mjg(1)
222       IF(lwp) WRITE(numout,*) '             1d configuration resets nimpp and njmpp to zoom sw corner'
223      ENDIF
224         
225   END SUBROUTINE dom_glo
226
227   !!======================================================================
228END MODULE domcfg