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 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90

Last change on this file was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.
File size: 10.9 KB
Line 
1MODULE domcfg
2   !!==============================================================================
3   !!                       ***  MODULE domcfg   ***
4   !! Ocean initialization : domain configuration initialization
5   !!==============================================================================
6   !! History :  1.0  ! 2003-09  (G. Madec)  Original code
7   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   dom_cfg        : initialize the domain configuration
12   !!----------------------------------------------------------------------
13   USE dom_oce         ! ocean space and time domain
14   USE phycst          ! physical constants
15   USE in_out_manager  ! I/O manager
16   USE lib_mpp         ! distributed memory computing library
17   USE timing          ! Timing
18   USE c1d             ! 1D configuration
19   USE domc1d          ! 1D configuration: column location
20
21   USE yomhook, ONLY: lhook, dr_hook
22   USE parkind1, ONLY: jprb, jpim
23
24   IMPLICIT NONE
25   PRIVATE
26
27   PUBLIC   dom_cfg    ! called by opa.F90
28
29   !!----------------------------------------------------------------------
30   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009)
31   !! $Id$
32   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
33   !!----------------------------------------------------------------------
34CONTAINS
35
36   SUBROUTINE dom_cfg
37   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
38   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
39   REAL(KIND=jprb)               :: zhook_handle
40
41   CHARACTER(LEN=*), PARAMETER :: RoutineName='DOM_CFG'
42
43   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
44
45      !!----------------------------------------------------------------------
46      !!                  ***  ROUTINE dom_cfg  ***
47      !!                   
48      !! ** Purpose :   set the domain configuration
49      !!
50      !!----------------------------------------------------------------------
51      !
52      IF( nn_timing == 1 )  CALL timing_start('dom_cfg')
53      !
54      IF(lwp) THEN                   ! Control print
55         WRITE(numout,*)
56         WRITE(numout,*) 'dom_cfg : set the ocean configuration'
57         WRITE(numout,*) '~~~~~~~ '
58         WRITE(numout,*) '   ocean model configuration used :   cp_cfg = ', cp_cfg, ' jp_cfg = ', jp_cfg
59         !
60         WRITE(numout,*) '   global domain lateral boundaries'
61         !
62         IF( jperio == 0 )   WRITE(numout,*) '      jperio= 0, closed'
63         IF( jperio == 1 )   WRITE(numout,*) '      jperio= 1, cyclic east-west'
64         IF( jperio == 2 )   WRITE(numout,*) '      jperio= 2, equatorial symmetric'
65         IF( jperio == 3 )   WRITE(numout,*) '      jperio= 3, north fold with T-point pivot'
66         IF( jperio == 4 )   WRITE(numout,*) '      jperio= 4, cyclic east-west and north fold with T-point pivot'
67         IF( jperio == 5 )   WRITE(numout,*) '      jperio= 5, north fold with F-point pivot'
68         IF( jperio == 6 )   WRITE(numout,*) '      jperio= 6, cyclic east-west and north fold with F-point pivot'
69      ENDIF
70      !
71      IF( jperio <  0 .OR. jperio > 6 )   CALL ctl_stop( 'jperio is out of range' )
72      !
73      CALL dom_glo                   ! global domain versus zoom and/or local domain
74      !
75      IF( nn_timing == 1 )  CALL timing_stop('dom_cfg')
76      !
77   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
78   END SUBROUTINE dom_cfg
79
80
81   SUBROUTINE dom_glo
82      !!----------------------------------------------------------------------
83      !!                     ***  ROUTINE dom_glo  ***
84      !!
85      !! ** Purpose :   initialization for global domain, zoom and local domain
86      !!
87      !! ** Method  :   
88      !!
89      !! ** Action  : - mig  , mjg :
90      !!              - mi0  , mi1   :
91      !!              - mj0, , mj1   :
92      !!----------------------------------------------------------------------
93      INTEGER ::   ji, jj   ! dummy loop argument
94      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
95      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
96      REAL(KIND=jprb)               :: zhook_handle
97
98      CHARACTER(LEN=*), PARAMETER :: RoutineName='DOM_GLO'
99
100      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
101
102      !!----------------------------------------------------------------------
103      !                              ! recalculate jpizoom/jpjzoom given lat/lon
104      IF( lk_c1d .AND. ln_c1d_locpt )  CALL dom_c1d( rn_lat1d, rn_lon1d )
105      !
106      !                        ! ============== !
107      !                        !  Local domain  !
108      !                        ! ============== !
109      DO ji = 1, jpi                 ! local domain indices ==> data domain indices
110        mig(ji) = ji + jpizoom - 1 + nimpp - 1
111      END DO
112      DO jj = 1, jpj
113        mjg(jj) = jj + jpjzoom - 1 + njmpp - 1
114      END DO
115      !
116      !                              ! data domain indices ==> local domain indices
117      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
118      !                                   !local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
119      DO ji = 1, jpidta
120        mi0(ji) = MAX( 1, MIN( ji - jpizoom + 1 - nimpp + 1, jpi+1 ) )
121        mi1(ji) = MAX( 0, MIN( ji - jpizoom + 1 - nimpp + 1, jpi   ) )
122      END DO
123      DO jj = 1, jpjdta
124        mj0(jj) = MAX( 1, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj+1 ) )
125        mj1(jj) = MAX( 0, MIN( jj - jpjzoom + 1 - njmpp + 1, jpj   ) )
126      END DO
127      IF(lwp) THEN                   ! control print
128         WRITE(numout,*)
129         WRITE(numout,*) 'dom_glo : domain: data / local '
130         WRITE(numout,*) '~~~~~~~ '
131         WRITE(numout,*) '          data input domain    : jpidta = ', jpidta,   &
132            &                                            ' jpjdta = ', jpjdta, ' jpkdta = ', jpkdta
133         WRITE(numout,*) '          global or zoom domain: jpiglo = ', jpiglo,   &
134            &                                            ' jpjglo = ', jpjglo, ' jpk    = ', jpk
135         WRITE(numout,*) '          local domain         : jpi    = ', jpi   ,   &
136            &                                            ' jpj    = ', jpj   , ' jpk    = ', jpk
137         WRITE(numout,*)
138         WRITE(numout,*) '          south-west indices    jpizoom = ', jpizoom,   &
139            &                                           ' jpjzoom = ', jpjzoom
140         WRITE(numout,*)
141         WRITE(numout,*) '          conversion local  ==> data i-index domain'
142         WRITE(numout,25)              (mig(ji),ji = 1,jpi)
143         WRITE(numout,*)
144         WRITE(numout,*) '          conversion data   ==> local  i-index domain'
145         WRITE(numout,*) '             starting index'
146         WRITE(numout,25)              (mi0(ji),ji = 1,jpidta)
147         WRITE(numout,*) '             ending index'
148         WRITE(numout,25)              (mi1(ji),ji = 1,jpidta)
149         WRITE(numout,*)
150         WRITE(numout,*) '          conversion local  ==> data j-index domain'
151         WRITE(numout,25)              (mjg(jj),jj = 1,jpj)
152         WRITE(numout,*)
153         WRITE(numout,*) '          conversion data  ==> local j-index domain'
154         WRITE(numout,*) '             starting index'
155         WRITE(numout,25)              (mj0(jj),jj = 1,jpjdta)
156         WRITE(numout,*) '             ending index'
157         WRITE(numout,25)              (mj1(jj),jj = 1,jpjdta)
158      ENDIF
159 25   FORMAT( 100(10x,19i4,/) )
160
161      !                        ! ============== !
162      !                        !  Zoom domain   !
163      !                        ! ============== !
164      !                              ! zoom control
165      IF( jpiglo + jpizoom - 1  >  jpidta .OR.   &
166          jpjglo + jpjzoom - 1  >  jpjdta      ) &
167          &   CALL ctl_stop( ' global or zoom domain exceed the data domain ! ' )
168
169      !                              ! set zoom flag
170      IF( jpiglo < jpidta .OR. jpjglo < jpjdta )   lzoom = .TRUE.
171
172      !                              ! set zoom type flags
173      IF( lzoom .AND. jpizoom /= 1 )   lzoom_w = .TRUE.                     !
174      IF( lzoom .AND. jpjzoom /= 1 )   lzoom_s = .TRUE.
175      IF( lzoom .AND. jpiglo + jpizoom -1 /= jpidta )   lzoom_e = .TRUE.
176      IF( lzoom .AND. jpjglo + jpjzoom -1 /= jpjdta )   lzoom_n = .TRUE.
177      IF(lwp) THEN
178         WRITE(numout,*)
179         WRITE(numout,*) '          zoom flags : '
180         WRITE(numout,*) '             lzoom   = ', lzoom  , ' (T = zoom, F = global )'
181         WRITE(numout,*) '             lzoom_e = ', lzoom_e, ' (T = forced closed east  boundary)'
182         WRITE(numout,*) '             lzoom_w = ', lzoom_w, ' (T = forced closed west  boundary)'
183         WRITE(numout,*) '             lzoom_s = ', lzoom_s, ' (T = forced closed South boundary)'
184         WRITE(numout,*) '             lzoom_n = ', lzoom_n, ' (T = forced closed North boundary)'
185      ENDIF
186      IF(  ( lzoom_e .OR. lzoom_w )  .AND.  ( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 )  )   &
187           &   CALL ctl_stop( ' Your zoom choice is inconsistent with east-west cyclic boundary condition' )
188      IF(  lzoom_n  .AND.  ( 3 <= jperio .AND. jperio <= 6 )  )   &
189           &   CALL ctl_stop( ' Your zoom choice is inconsistent with North fold boundary condition' )
190
191      !                              ! Pre-defined arctic/antarctic zoom of ORCA configuration flag
192      IF( cp_cfg == "orca" ) THEN
193         SELECT CASE ( jp_cfg )
194         CASE ( 2 )                               !  ORCA_R2 configuration
195            IF(  cp_cfz == "arctic"    .AND. jpiglo  == 142    .AND. jpjglo  ==  53 .AND.   &
196               & jpizoom ==  21    .AND. jpjzoom ==  97         )   THEN
197              IF(lwp) WRITE(numout,*) '          ORCA configuration: arctic zoom '
198            ENDIF
199            IF(  cp_cfz == "antarctic" .AND. jpiglo  == jpidta .AND. jpjglo  ==  50 .AND.   &
200               & jpizoom ==   1    .AND. jpjzoom ==   1         )   THEN
201              IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic zoom '
202            ENDIF
203            !                             
204         CASE ( 05 )                              !  ORCA_R05 configuration
205            IF(    cp_cfz == "arctic"    .AND. jpiglo  == 562    .AND. jpjglo  == 202 .AND.   &
206               & jpizoom ==  81    .AND. jpjzoom == 301         )   THEN
207              IF(lwp) WRITE(numout,*) '          ORCA configuration: arctic zoom '
208            ENDIF
209            IF(    cp_cfz == "antarctic" .AND. jpiglo  == jpidta .AND. jpjglo  == 187 .AND.   &
210               & jpizoom ==   1    .AND. jpjzoom ==   1         )   THEN
211              IF(lwp) WRITE(numout,*) '          ORCA configuration: antarctic zoom '
212            ENDIF
213         END SELECT
214         !
215      ENDIF
216      !
217      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
218   END SUBROUTINE dom_glo
219
220   !!======================================================================
221END MODULE domcfg
Note: See TracBrowser for help on using the repository browser.