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/OPA_SRC – NEMO

source: trunk/NEMO/OPA_SRC/opa.F90 @ 833

Last change on this file since 833 was 833, checked in by rblod, 16 years ago

Merge branche dev_002_LIM back to trunk ticket #70 and #71

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 19.4 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   !!   opa_init       : initialization of the opa model
10   !!   opa_flg        : initialisation of algorithm flag
11   !!   opa_closefile  : close remaining files
12   !!----------------------------------------------------------------------
13   !! History :
14   !!   4.0  !  90-10  (C. Levy, G. Madec)  Original code
15   !!   7.0  !  91-11  (M. Imbard, C. Levy, G. Madec)
16   !!   7.1  !  93-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
17   !!                   M. Guyon, A. Lazar, P. Delecluse, C. Perigaud,
18   !!                   G. Caniaux, B. Colot, C. Maes ) release 7.1
19   !!        !  92-06  (L.Terray) coupling implementation
20   !!        !  93-11  (M.A. Filiberti) IGLOO sea-ice
21   !!   8.0  !  96-03  (M. Imbard, C. Levy, G. Madec, O. Marti,
22   !!                   M. Guyon, A. Lazar, P. Delecluse, L.Terray,
23   !!                   M.A. Filiberti, J. Vialar, A.M. Treguier,
24   !!                   M. Levy)  release 8.0
25   !!   8.1  !  97-06  (M. Imbard, G. Madec)
26   !!   8.2  !  99-11  (M. Imbard, H. Goosse)  LIM sea-ice model
27   !!        !  99-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
28   !!        !  00-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
29   !!   9.0  !  02-08  (G. Madec)  F90: Free form and modules
30   !!    "   !  04-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
31   !!    "   !  04-08  (C. Talandier) New trends organization
32   !!    "   !  05-06  (C. Ethe) Add the 1D configuration possibility
33   !!    "   !  05-11  (V. Garnier) Surface pressure gradient organization
34   !!    "   !  06-03  (L. Debreu, C. Mazauric)  Agrif implementation
35   !!    "   !  06-04  (G. Madec, R. Benshila)  Step reorganization
36   !!----------------------------------------------------------------------
37   !! * Modules used
38   USE cpl_oce         ! ocean-atmosphere-sea ice coupled exchanges
39   USE dom_oce         ! ocean space domain variables
40   USE oce             ! dynamics and tracers variables
41   USE trdmod_oce      ! ocean variables trends
42   USE daymod          ! calendar
43   USE in_out_manager  ! I/O manager
44   USE lib_mpp         ! distributed memory computing
45
46   USE domcfg          ! domain configuration               (dom_cfg routine)
47   USE mppini          ! shared/distributed memory setting (mpp_init routine)
48   USE domain          ! domain initialization             (dom_init routine)
49   USE obc_par         ! open boundary cond. parameters
50   USE obcini          ! open boundary cond. initialization (obc_ini routine)
51   USE istate          ! initial state setting          (istate_init routine)
52   USE eosbn2          ! equation of state            (eos bn2 routine)
53   USE zpshde          ! partial step: hor. derivative (zps_hde routine)
54
55   ! ocean physics
56   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine)
57   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine)
58   USE zdfini
59
60   USE phycst          ! physical constant                  (par_cst routine)
61#if defined key_lim3
62   USE iceini          ! initialization of sea-ice         (ice_init routine)
63#endif
64#if defined key_lim2
65   USE iceini_2        ! initialization of sea-ice         (ice_init_2 routine)
66#endif
67   USE cpl             ! coupled ocean/atmos.              (cpl_init routine)
68   USE ocfzpt          ! ocean freezing point              (oc_fz_pt routine)
69   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine)
70   USE flxfwb          ! freshwater budget correction  (flx_fwb_init routine)
71   USE flxmod          ! thermohaline forcing of the ocean (flx_init routine)
72
73   USE diaptr          ! poleward transports           (dia_ptr_init routine)
74
75   USE step            ! OPA time-stepping                  (stp     routine)
76#if defined key_oasis3
77   USE cpl_oasis3      ! OASIS3 coupling (to ECHAM5)
78#elif defined key_oasis4
79   USE cpl_oasis4      ! OASIS4 coupling (to ECHAM5)
80#endif
81   USE dynspg_oce      ! Control choice of surface pressure gradient schemes
82   USE prtctl          ! Print control                 (prt_ctl_init routine)
83   USE ini1d           ! re-initialization of u-v mask for the 1D configuration
84   USE dyncor1d        ! Coriolis factor at T-point
85   USE step1d          ! Time stepping loop for the 1D configuration
86
87   USE initrc          ! Initialization of the passive tracers
88
89   IMPLICIT NONE
90   PRIVATE
91
92   !! * Module variables
93   CHARACTER (len=64) ::        &
94      cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
95
96   !! * Routine accessibility
97   PUBLIC opa_model      ! called by model.F90
98   PUBLIC opa_init
99   !!----------------------------------------------------------------------
100   !!  OPA 9.0 , LOCEAN-IPSL (2005)
101   !! $Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/opa.F90,v 1.38 2007/06/05 10:32:02 opalod Exp $
102   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
103   !!----------------------------------------------------------------------
104
105CONTAINS
106
107   SUBROUTINE opa_model
108      !!----------------------------------------------------------------------
109      !!                     ***  ROUTINE opa  ***
110      !!
111      !! ** Purpose :   opa solves the primitive equations on an orthogonal
112      !!      curvilinear mesh on the sphere.
113      !!
114      !! ** Method  : - model general initialization
115      !!              - launch the time-stepping (stp routine)
116      !!
117      !! References :
118      !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual.
119      !!              internal report, IPSL.
120      !!----------------------------------------------------------------------
121      INTEGER ::   istp       ! time step index
122      !!----------------------------------------------------------------------
123
124#if defined key_agrif
125      CALL Agrif_Init_Grids()
126#endif
127     
128      CALL opa_init  ! Initializations
129
130      ! check that all process are still there... If some process have an error,
131      ! they will never enter in step and other processes will wait until the end of the cpu time!
132      IF( lk_mpp )   CALL mpp_max(nstop)
133
134      IF( lk_cfg_1d ) THEN
135         istp = nit000
136         DO WHILE ( istp <= nitend .AND. nstop == 0 )
137#if defined key_agrif
138            CALL Agrif_Step(stp_1d)
139#else
140            CALL stp_1d( istp )
141#endif
142            istp = istp + 1
143
144            IF( lk_mpp )   CALL mpp_max(nstop)
145 
146         END DO
147      ELSE
148         istp = nit000
149         DO WHILE ( istp <= nitend .AND. nstop == 0 )
150#if defined key_agrif
151            CALL Agrif_Step(stp)
152#else
153            CALL stp( istp )
154#endif
155            istp = istp + 1
156
157            IF( lk_mpp )   CALL mpp_max(nstop)
158           
159         END DO
160      ENDIF
161      !                                     ! ========= !
162      !                                     !  Job end  !
163      !                                     ! ========= !
164
165      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
166
167      IF( nstop /= 0 .AND. lwp ) THEN                 ! error print
168         WRITE(numout,cform_err)
169         WRITE(numout,*) nstop, ' error have been found' 
170      ENDIF
171
172      CALL opa_closefile
173#if defined key_oasis3 || defined key_oasis4
174      call cpl_prism_finalize
175#else
176      IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp)
177#endif
178
179   END SUBROUTINE opa_model
180
181
182   SUBROUTINE opa_init
183      !!----------------------------------------------------------------------
184      !!                     ***  ROUTINE opa_init  ***
185      !!
186      !! ** Purpose :   initialization of the opa model
187      !!
188      !!----------------------------------------------------------------------
189#if defined key_coupled
190      INTEGER ::   itro, istp0        ! ???
191#endif
192#if defined key_oasis3 || defined key_oasis4
193      INTEGER :: localComm
194#endif
195      CHARACTER (len=20) ::   namelistname
196      CHARACTER (len=28) ::   file_out
197      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   &
198         &             isplt , jsplt , njctls, njctle, nbench, nbit_cmp
199      !!----------------------------------------------------------------------
200
201      ! Initializations
202      ! ===============
203
204      file_out = 'ocean.output'
205     
206      ! open listing and namelist units
207      CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
208         &         'SEQUENTIAL', 1, 6, .FALSE., 1 )
209
210      WRITE(numout,*)
211      WRITE(numout,*) '                 L O D Y C - I P S L'
212      WRITE(numout,*) '                     O P A model'
213      WRITE(numout,*) '            Ocean General Circulation Model'
214      WRITE(numout,*) '               version OPA 9.0  (2005) '
215      WRITE(numout,*)
216      WRITE(numout,*)
217
218      namelistname = 'namelist'
219      CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   &
220         &         1, numout, .FALSE., 1 )
221
222      ! Namelist namctl : Control prints & Benchmark
223      REWIND( numnam )
224      READ  ( numnam, namctl )
225
226#if defined key_oasis3 || defined key_oasis4
227      call cpl_prism_init(localComm)
228      ! Nodes selection
229      narea = mynode(localComm)
230#else
231      ! Nodes selection
232      narea = mynode()
233#endif
234      narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 )
235      lwp   = narea == 1
236
237      ! open additionnal listing
238      IF( ln_ctl )   THEN
239         IF( narea-1 > 0 )   THEN
240            WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1
241            CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   &
242               &         'SEQUENTIAL', 1, numout, .FALSE., 1 )
243            lwp = .TRUE.
244            !
245            WRITE(numout,*)
246            WRITE(numout,*) '                 L O D Y C - I P S L'
247            WRITE(numout,*) '                     O P A model'
248            WRITE(numout,*) '            Ocean General Circulation Model'
249            WRITE(numout,*) '               version OPA 9.0  (2005) '
250            WRITE(numout,*) '                   MPI Ocean output '
251            WRITE(numout,*)
252            WRITE(numout,*)
253         ENDIF
254      ENDIF
255
256      !                                     ! ============================== !
257      !                                     !  Model general initialization  !
258      !                                     ! ============================== !
259
260      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
261
262      CALL opa_flg                          ! Control prints & Benchmark
263
264                                            ! Domain decomposition
265      IF( jpni*jpnj == jpnij ) THEN
266         CALL mpp_init                          ! standard cutting out
267      ELSE
268         CALL mpp_init2                         ! eliminate land processors
269      ENDIF
270     
271      CALL phy_cst                          ! Physical constants
272
273      CALL dom_cfg                          ! Domain configuration
274     
275      CALL dom_init                         ! Domain
276
277      IF( ln_ctl )      CALL prt_ctl_init   ! Print control
278
279      IF( lk_cfg_1d )   CALL fcorio_1d      ! redefine Coriolis at T-point
280
281      IF( lk_obc    )   CALL obc_init       ! Open boundaries
282
283      CALL day( nit000 )                    ! Calendar
284
285      CALL istate_init                      ! ocean initial state (Dynamics and tracers)
286
287      CALL oc_fz_pt                         ! Surface freezing point
288
289#if defined key_lim3
290      CALL ice_init                         ! Sea ice model LIM3
291#endif
292
293#if defined key_lim2
294      CALL ice_init_2                       ! Sea ice model LIM2
295#endif
296
297      !                                     ! Ocean physics
298
299      CALL ldf_dyn_init                         ! Lateral ocean momentum physics
300
301      CALL ldf_tra_init                         ! Lateral ocean tracer physics
302
303      CALL zdf_init                             ! Vertical ocean physics
304
305      CALL trd_mod_init                         ! Mixed-layer/Vorticity/Integral constraints trends
306
307
308#if defined key_passivetrc
309      CALL ini_trc                           ! Passive tracers
310#endif
311
312#if defined key_coupled && ! defined key_oasis3 && ! defined key_oasis4
313      itro  = nitend - nit000 + 1           ! Coupled
314      istp0 = NINT( rdt )
315      CALL cpl_init( itro, nexco, istp0 )   ! Signal processing and process id exchange
316#endif
317
318#if defined key_oasis3 || defined key_oasis4
319      CALL cpl_prism_define
320#endif
321
322      CALL flx_init                         ! Thermohaline forcing initialization
323
324      CALL flx_fwb_init                     ! FreshWater Budget correction
325
326      CALL dia_ptr_init                     ! Poleward TRansports initialization
327
328      !                                     ! =============== !
329      !                                     !  time stepping  !
330      !                                     ! =============== !
331
332      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA
333
334      IF( lk_cfg_1d  )  THEN
335         CALL init_1d
336      ENDIF
337
338   END SUBROUTINE opa_init
339
340
341   SUBROUTINE opa_flg
342      !!----------------------------------------------------------------------
343      !!                     ***  ROUTINE opa  ***
344      !!
345      !! ** Purpose :   Initialize logical flags that control the choice of
346      !!      some algorithm or control print
347      !!
348      !! ** Method  :    Read in namilist namflg logical flags
349      !!
350      !! History :
351      !!   9.0  !  03-11  (G. Madec)  Original code
352      !!----------------------------------------------------------------------
353      !! * Local declarations
354
355      NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst
356      !!----------------------------------------------------------------------
357
358      ! Parameter control and print
359      ! ---------------------------
360      IF(lwp) THEN
361         WRITE(numout,*)
362         WRITE(numout,*) 'opa_flg: Control prints & Benchmark'
363         WRITE(numout,*) '~~~~~~~ '
364         WRITE(numout,*) '          Namelist namctl'
365         WRITE(numout,*) '             run control (for debugging)     ln_ctl    = ', ln_ctl
366         WRITE(numout,*) '             level of print                  nprint    = ', nprint
367         WRITE(numout,*) '             Start i indice for SUM control  nictls    = ', nictls
368         WRITE(numout,*) '             End i indice for SUM control    nictle    = ', nictle
369         WRITE(numout,*) '             Start j indice for SUM control  njctls    = ', njctls
370         WRITE(numout,*) '             End j indice for SUM control    njctle    = ', njctle
371         WRITE(numout,*) '             number of proc. following i     isplt     = ', isplt
372         WRITE(numout,*) '             number of proc. following j     jsplt     = ', jsplt
373         WRITE(numout,*) '             benchmark parameter (0/1)       nbench    = ', nbench
374         WRITE(numout,*) '             bit comparison mode (0/1)       nbit_cmp  = ', nbit_cmp
375      ENDIF
376
377      ! ... Control the sub-domain area indices for the control prints
378      IF( ln_ctl )   THEN
379         IF( lk_mpp )   THEN
380            ! the domain is forced to the real splitted domain in MPI
381            isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj
382         ELSE
383            IF( isplt == 1 .AND. jsplt == 1  ) THEN
384               CALL ctl_warn( '          - isplt & jsplt are equal to 1',   &
385                    &         '          - the print control will be done over the whole domain' )
386            ENDIF
387
388            ! compute the total number of processors ijsplt
389            ijsplt = isplt*jsplt
390         ENDIF
391
392         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
393         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
394
395         ! Control the indices used for the SUM control
396         IF( nictls+nictle+njctls+njctle == 0 )   THEN
397            ! the print control is done over the default area
398            lsp_area = .FALSE.
399         ELSE
400            ! the print control is done over a specific  area
401            lsp_area = .TRUE.
402            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
403               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
404               nictls = 1
405            ENDIF
406
407            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
408               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
409               nictle = jpiglo
410            ENDIF
411
412            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
413               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
414               njctls = 1
415            ENDIF
416
417            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
418               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
419               njctle = jpjglo
420            ENDIF
421
422         ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 )
423       ENDIF            ! IF(ln_ctl)
424
425      IF( nbench == 1 )   THEN
426         SELECT CASE ( cp_cfg )
427         CASE ( 'gyre' )
428            CALL ctl_warn( '          The Benchmark is activated ' )
429         CASE DEFAULT
430            CALL ctl_stop( '          The Benchmark is based on the GYRE configuration: key_gyre must &
431               &                      be used or set nbench = 0' )
432         END SELECT
433      ENDIF
434
435      IF( nbit_cmp == 1 )   THEN
436         CALL ctl_warn( '          Bit comparison enabled. Single and multiple processor results must bit compare', &
437              &         '          WARNING: RESULTS ARE NOT PHYSICAL.' )
438      ENDIF
439
440
441      ! Read Namelist namflg : algorithm FLaG
442      ! --------------------
443      REWIND ( numnam )
444      READ   ( numnam, namflg )
445
446      ! Parameter control and print
447      ! ---------------------------
448      IF(lwp) THEN
449         WRITE(numout,*)
450         WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm'
451         WRITE(numout,*) '~~~~~~~'
452         WRITE(numout,*) '          Namelist namflg : set algorithm flags'
453         WRITE(numout,*) '             centered (F) or semi-implicit (T)   ln_dynhpg_imp = ', ln_dynhpg_imp
454         WRITE(numout,*) '             hydrostatic pressure gradient'
455         WRITE(numout,*) '             add dynhpg implicit variable        nn_dynhpg_rst = ', nn_dynhpg_rst
456         WRITE(numout,*) '             in restart ot not nn_dynhpg_rst'
457      ENDIF
458      IF( .NOT. ln_dynhpg_imp )   nn_dynhpg_rst = 0      ! force no adding dynhpg implicit variables in restart
459
460   END SUBROUTINE opa_flg
461
462
463   SUBROUTINE opa_closefile
464      !!----------------------------------------------------------------------
465      !!                     ***  ROUTINE opa_closefile  ***
466      !!
467      !! ** Purpose :   Close the files
468      !!
469      !! ** Method  :
470      !!
471      !! History :
472      !!   9.0  !  05-01  (O. Le Galloudec)  Original code
473      !!----------------------------------------------------------------------
474      !! * Modules used
475      USE dtatem        ! temperature data
476      USE dtasal        ! salinity data
477      USE dtasst        ! sea surface temperature data
478      !!----------------------------------------------------------------------
479
480      IF ( lk_mpp ) CALL mppsync
481
482      ! 1. Unit close
483      ! -------------
484
485      CLOSE( numnam )           ! namelist
486      CLOSE( numout )           ! standard model output file
487
488      IF(lwp) CLOSE( numstp )   ! time-step file
489      IF(lwp) CLOSE( numsol )
490
491   END SUBROUTINE opa_closefile
492
493   !!======================================================================
494END MODULE opa
Note: See TracBrowser for help on using the repository browser.