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.
opa.F90 in trunk/NEMO/OFF_SRC – NEMO

source: trunk/NEMO/OFF_SRC/opa.F90 @ 1656

Last change on this file since 1656 was 1497, checked in by cetlod, 15 years ago

update the offline part of opa.F90 and eosbn2.F90 modules, see ticket:473

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 14.5 KB
Line 
1MODULE opa
2   !!==============================================================================
3   !!                       ***  MODULE opa   ***
4   !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice)
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   opa_model      : solve ocean dynamics, tracer and/or sea-ice
9   !!----------------------------------------------------------------------
10   !! * Modules used
11   USE dom_oce         ! ocean space domain variables
12   USE oce             ! dynamics and tracers variables
13   USE daymod          ! calendar
14   USE in_out_manager  ! I/O manager
15   USE lib_mpp         ! distributed memory computing
16
17   USE domcfg          ! domain configuration               (dom_cfg routine)
18   USE mppini          ! shared/distributed memory setting (mpp_init routine)
19   USE domain          ! domain initialization             (dom_init routine)
20   USE istate          ! initial state setting          (istate_init routine)
21   USE eosbn2          ! equation of state            (eos bn2 routine)
22
23   ! ocean physics
24   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
25   USE traqsr          ! solar radiation penetration   (tra_qsr_init routine)
26
27   USE phycst          ! physical constant                  (par_cst routine)
28   USE dtadyn          ! Lecture and Interpolation of the dynamical fields
29   USE trcini          ! Initilization of the passive tracers
30   USE step            ! OPA time-stepping                  (stp     routine)
31
32   USE iom
33#if defined key_iomput
34   USE  mod_ioclient
35#endif
36
37   IMPLICIT NONE
38   PRIVATE
39
40   !! * Module variables
41   CHARACTER (len=64) ::        &
42      cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
43
44   !! * Routine accessibility
45   PUBLIC opa_model      ! called by model.F90
46   PUBLIC opa_init
47   !!----------------------------------------------------------------------
48   !!   OPA 9.0 , LOCEAN-IPSL  (2005)
49   !!   $Id$
50   !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
51   !!----------------------------------------------------------------------
52
53CONTAINS
54
55   SUBROUTINE opa_model
56      !!----------------------------------------------------------------------
57      !!                     ***  ROUTINE opa  ***
58      !!
59      !! ** Purpose :   opa solves the primitive equations on an orthogonal
60      !!      curvilinear mesh on the sphere.
61      !!
62      !! ** Method  : - model general initialization
63      !!              - launch the time-stepping (stp routine)
64      !!
65      !! References :
66      !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
67      !!              internal report, IPSL.
68      !!----------------------------------------------------------------------
69      INTEGER ::   istp       ! time step index
70      !!----------------------------------------------------------------------
71
72      CALL opa_init  ! Initializations
73
74      IF( lk_mpp )   CALL mpp_max( nstop )
75
76      ! check that all process are still there... If some process have an error,
77      ! they will never enter in step and other processes will wait until the end of the cpu time!
78      IF( lk_mpp )   CALL mpp_max( nstop )
79
80      istp = nit000
81         !
82      DO WHILE ( istp <= nitend .AND. nstop == 0 )
83         CALL stp( istp )
84         istp = istp + 1
85         IF( lk_mpp )   CALL mpp_max( nstop )
86      END DO
87      !                                     ! ========= !
88      !                                     !  Job end  !
89      !                                     ! ========= !
90
91      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
92
93      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print
94         WRITE(numout,cform_err)
95         WRITE(numout,*) nstop, ' error have been found'
96      ENDIF
97
98      CALL opa_closefile
99
100      IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp)
101      !
102   END SUBROUTINE opa_model
103
104
105   SUBROUTINE opa_init
106      !!----------------------------------------------------------------------
107      !!                     ***  ROUTINE opa_init ***
108      !!
109      !! ** Purpose :   opa solves the primitive equations on an orthogonal
110      !!      curvilinear mesh on the sphere.
111      !!
112      !! ** Method  : - model general initialization
113      !!
114      !! References :
115      !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
116      !!              internal report, IPSL.
117      !!
118      !! History :
119      !!   4.0  !  90-10  (C. Levy, G. Madec)  Original code
120      !!   7.0  !  91-11  (M. Imbard, C. Levy, G. Madec)
121      !!   7.1  !  93-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
122      !!                   M. Guyon, A. Lazar, P. Delecluse, C. Perigaud,
123      !!                   G. Caniaux, B. Colot, C. Maes ) release 7.1
124      !!        !  92-06  (L.Terray) coupling implementation
125      !!        !  93-11  (M.A. Filiberti) IGLOO sea-ice
126      !!   8.0  !  96-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
127      !!                   M. Guyon, A. Lazar, P. Delecluse, L.Terray,
128      !!                   M.A. Filiberti, J. Vialar, A.M. Treguier,
129      !!                   M. Levy)  release 8.0
130      !!   8.1  !  97-06  (M. Imbard, G. Madec)
131      !!   8.2  !  99-11  (M. Imbard, H. Goosse)  LIM sea-ice model
132      !!        !  99-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
133      !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
134      !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules
135      !!----------------------------------------------------------------------
136      !! * Local declarations
137#if defined key_iomput
138      INTEGER :: localComm
139#endif
140      CHARACTER (len=20) ::   namelistname
141      CHARACTER (len=28) ::   file_out
142      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   &
143         &             isplt , jsplt , njctls, njctle, nbench
144
145      !!----------------------------------------------------------------------
146
147      ! Initializations
148      ! ===============
149
150      file_out = 'ocean.output'
151
152      ! open listing and namelist units
153      CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
154         &         'SEQUENTIAL', 1, 6, .FALSE., 1 )
155
156      namelistname = 'namelist'
157      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
158         &         1, numout, .FALSE., 1 )
159
160      WRITE(numout,*)
161      WRITE(numout,*) '                 L O D Y C - I P S L'
162      WRITE(numout,*) '                     O P A model'
163      WRITE(numout,*) '            Ocean General Circulation Model'
164      WRITE(numout,*) '               version OPA 9.0  (2005) '
165      WRITE(numout,*)
166      WRITE(numout,*)
167
168      ! Namelist namctl : Control prints & Benchmark
169      REWIND( numnam )
170      READ  ( numnam, namctl )
171
172#if defined key_iomput
173      CALL init_ioclient(localcomm)
174      narea = mynode(localComm)
175#else
176      ! Nodes selection
177      narea = mynode()
178#endif
179
180      ! Nodes selection
181      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 )
182      lwp   = narea == 1
183
184      ! open additionnal listing
185      IF( ln_ctl )   THEN
186         IF( narea-1 > 0 )   THEN
187            WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1
188            CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
189               &         'SEQUENTIAL', 1, numout, .FALSE., 1 )
190            lwp = .TRUE.
191            !
192            WRITE(numout,*)
193            WRITE(numout,*) '                 L O D Y C - I P S L'
194            WRITE(numout,*) '                     O P A model'
195            WRITE(numout,*) '            Ocean General Circulation Model'
196            WRITE(numout,*) '               version OPA 9.0  (2005) '
197            WRITE(numout,*) '                   MPI Ocean output '
198            WRITE(numout,*)
199            WRITE(numout,*)
200         ENDIF
201      ENDIF
202
203      CALL opa_flg                          ! Control prints & Benchmark
204
205      !                                     ! ============================== !
206      !                                     !  Model general initialization  !
207      !                                     ! ============================== !
208
209      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
210
211                                            ! Domain decomposition
212      IF( jpni * jpnj == jpnij ) THEN
213         CALL mpp_init                          ! standard cutting out
214      ELSE
215         CALL mpp_init2                         ! eliminate land processors
216      ENDIF
217     
218      CALL phy_cst                          ! Physical constants
219
220      CALL eos_init                         ! Equation of state
221
222      CALL dom_cfg                          ! Domain configuration
223
224      CALL dom_init                         ! Domain
225
226      CALL istate_init                      ! ocean initial state (Dynamics and tracers)
227     
228      CALL dta_dyn( nit000 )                 ! Initialization for the dynamics
229     
230      CALL trc_ini                           ! Passive tracers
231      !                                     ! Ocean physics
232      CALL tra_qsr_init                         ! Solar radiation penetration
233
234#if ! defined key_off_degrad
235      CALL ldf_tra_init                         ! Lateral ocean tracer physics
236#endif
237      CALL iom_init( fjulday - adatrj )     ! iom_put initialization
238      !                                     ! =============== !
239      !                                     !  time stepping  !
240      !                                     ! =============== !
241
242      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
243
244   END SUBROUTINE opa_init
245
246   SUBROUTINE opa_flg
247      !!----------------------------------------------------------------------
248      !!                     ***  ROUTINE opa  ***
249      !!
250      !! ** Purpose :   Initialize logical flags that control the choice of
251      !!      some algorithm or control print
252      !!
253      !! ** Method  :    Read in namilist namflg logical flags
254      !!
255      !! History :
256      !!   9.0  !  03-11  (G. Madec)  Original code
257      !!----------------------------------------------------------------------
258      !! * Local declarations
259
260      ! Parameter control and print
261      ! ---------------------------
262      IF(lwp) THEN
263         WRITE(numout,*)
264         WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
265         WRITE(numout,*) '~~~~~~~ '
266         WRITE(numout,*) '          Namelist namctl'
267         WRITE(numout,*) '             run control (for debugging)     ln_ctl    = ', ln_ctl
268         WRITE(numout,*) '             level of print                  nprint    = ', nprint
269         WRITE(numout,*) '             Start i indice for SUM control  nictls    = ', nictls
270         WRITE(numout,*) '             End i indice for SUM control    nictle    = ', nictle
271         WRITE(numout,*) '             Start j indice for SUM control  njctls    = ', njctls
272         WRITE(numout,*) '             End j indice for SUM control    njctle    = ', njctle
273         WRITE(numout,*) '             number of proc. following i     isplt     = ', isplt
274         WRITE(numout,*) '             number of proc. following j     jsplt     = ', jsplt
275         WRITE(numout,*) '             benchmark parameter (0/1)       nbench    = ', nbench
276      ENDIF
277
278      ! ... Control the sub-domain area indices for the control prints
279      IF( ln_ctl )   THEN
280         IF( lk_mpp )   THEN
281            ! the domain is forced to the real splitted domain in MPI
282            isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
283         ELSE
284            IF( isplt == 1 .AND. jsplt == 1  ) THEN
285               CALL ctl_warn( '          - isplt & jsplt are equal to 1',   &
286                    &         '          - the print control will be done over the whole domain' )
287            ENDIF
288
289            ! compute the total number of processors ijsplt
290            ijsplt = isplt*jsplt
291         ENDIF
292
293         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
294         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
295
296         ! Control the indices used for the SUM control
297         IF( nictls+nictle+njctls+njctle == 0 )   THEN
298            ! the print control is done over the default area
299            lsp_area = .FALSE.
300         ELSE
301            ! the print control is done over a specific  area
302            lsp_area = .TRUE.
303            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
304               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
305               nictls = 1
306            ENDIF
307
308            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
309               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
310               nictle = jpiglo
311            ENDIF
312
313            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
314               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
315               njctls = 1
316            ENDIF
317
318            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
319               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
320               njctle = jpjglo
321            ENDIF
322
323         ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 )
324       ENDIF            ! IF(ln_ctl)
325
326      IF( nbench == 1 )   THEN
327         SELECT CASE ( cp_cfg )
328         CASE ( 'gyre' )
329            CALL ctl_warn( '          The Benchmark is activated ' )
330         CASE DEFAULT
331            CALL ctl_stop( '          The Benchmark is based on the GYRE configuration: key_gyre must &
332               &                      be used or set nbench = 0' )
333         END SELECT
334      ENDIF
335
336   END SUBROUTINE opa_flg
337
338   SUBROUTINE opa_closefile
339      !!----------------------------------------------------------------------
340      !!                     ***  ROUTINE opa_closefile  ***
341      !!
342      !! ** Purpose :   Close the files
343      !!
344      !! ** Method  :
345      !!
346      !! History :
347      !!   9.0  !  05-01  (O. Le Galloudec)  Original code
348      !!----------------------------------------------------------------------
349      !!----------------------------------------------------------------------
350
351      IF ( lk_mpp ) CALL mppsync
352
353      ! 1. Unit close
354      ! -------------
355
356      CLOSE( numnam )           ! namelist
357      CLOSE( numout )           ! standard model output file
358
359      IF(lwp) CLOSE( numstp )   ! time-step file
360
361      CALL iom_close            ! close all input/output files
362
363   END SUBROUTINE opa_closefile
364
365   !!======================================================================
366END MODULE opa
Note: See TracBrowser for help on using the repository browser.