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.
Changeset 1593 for trunk/NEMO/OPA_SRC/opa.F90 – NEMO

Ignore:
Timestamp:
2009-08-06T17:56:26+02:00 (15 years ago)
Author:
smasson
Message:

stye review of opa.F90, see ticket:521

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/opa.F90

    r1581 r1593  
    44   !! Ocean system   : OPA ocean dynamics (including on-line tracers and sea-ice) 
    55   !!============================================================================== 
     6   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code 
     7   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec) 
     8   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
     9   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes )  release 7.1  
     10   !!             -   ! 1992-06  (L.Terray)  coupling implementation 
     11   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice  
     12   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,  
     13   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy)  release 8.0 
     14   !!            8.1  ! 1997-06  (M. Imbard, G. Madec) 
     15   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model  
     16   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP  
     17   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER) 
     18   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules 
     19   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces 
     20   !!             -   ! 2004-08  (C. Talandier) New trends organization 
     21   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility 
     22   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization 
     23   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation 
     24   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization 
     25   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
     26   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp 
     27   !!---------------------------------------------------------------------- 
    628 
    729   !!---------------------------------------------------------------------- 
     
    1133   !!   opa_closefile  : close remaining files 
    1234   !!---------------------------------------------------------------------- 
    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    !!    "   !  07-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 
    37    !!---------------------------------------------------------------------- 
    38    !! * Modules used 
    3935   USE oce             ! dynamics and tracers variables 
    4036   USE dom_oce         ! ocean space domain variables 
     
    4238   USE trdmod_oce      ! ocean variables trends 
    4339   USE daymod          ! calendar 
    44    USE in_out_manager  ! I/O manager 
    45    USE lib_mpp         ! distributed memory computing 
    46  
    4740   USE domcfg          ! domain configuration               (dom_cfg routine) 
    4841   USE mppini          ! shared/distributed memory setting (mpp_init routine) 
     
    5346   USE bdyini          ! unstructured open boundary cond. initialization (bdy_init routine) 
    5447   USE istate          ! initial state setting          (istate_init routine) 
    55    USE eosbn2          ! equation of state            (eos bn2 routine) 
    56    USE zpshde          ! partial step: hor. derivative (zps_hde routine) 
    57  
    58    ! ocean physics 
     48   USE eosbn2          ! equation of state                 (eos_init routine) 
    5949   USE ldfdyn          ! lateral viscosity setting      (ldfdyn_init routine) 
    6050   USE ldftra          ! lateral diffusivity setting    (ldftra_init routine) 
    6151   USE zdfini 
    62  
    6352   USE phycst          ! physical constant                  (par_cst routine) 
    6453   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine) 
    65  
    6654   USE diaptr          ! poleward transports           (dia_ptr_init routine) 
    67  
    6855   USE step            ! OPA time-stepping                  (stp     routine) 
    6956#if defined key_oasis3 
     
    7764   USE dyncor_c1d      ! Coriolis factor at T-point 
    7865   USE step_c1d        ! Time stepping loop for the 1D configuration 
    79  
    80    USE trcini          ! Initialization of the passive tracers 
     66   USE trcini          ! passive tracer initialisation 
     67    
    8168   USE iom 
     69   USE in_out_manager  ! I/O manager 
     70   USE lib_mpp         ! distributed memory computing 
    8271#if defined key_iomput 
    8372   USE mod_ioclient 
     
    8776   PRIVATE 
    8877 
    89    !! * Module variables 
    90    CHARACTER (len=64) ::        & 
    91       cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    92  
    93    !! * Routine accessibility 
    94    PUBLIC opa_model      ! called by model.F90 
    95    PUBLIC opa_init 
    96    !!---------------------------------------------------------------------- 
    97    !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     78   PUBLIC   opa_model   ! called by model.F90 
     79   PUBLIC   opa_init    ! needed by AGRIF 
     80 
     81   CHARACTER (len=64) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
     82 
     83   !!---------------------------------------------------------------------- 
     84   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    9885   !! $Id$ 
    9986   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     
    10794      !! 
    10895      !! ** Purpose :   opa solves the primitive equations on an orthogonal  
    109       !!      curvilinear mesh on the sphere. 
     96      !!              curvilinear mesh on the sphere. 
    11097      !! 
    11198      !! ** Method  : - model general initialization 
    11299      !!              - launch the time-stepping (stp routine) 
    113       !! 
    114       !! References : 
    115       !!      Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 
    116       !!              internal report, IPSL. 
     100      !!              - finalize the run by closing files and communications 
     101      !! 
     102      !! References : Madec, Delecluse,Imbard, and Levy, 1997:  internal report, IPSL. 
     103      !!              Madec, 2008, internal report, IPSL. 
    117104      !!---------------------------------------------------------------------- 
    118105      INTEGER ::   istp       ! time step index 
     
    120107 
    121108#if defined key_agrif 
    122       CALL Agrif_Init_Grids() 
    123 #endif 
    124        
    125       CALL opa_init  ! Initializations 
     109      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes 
     110#endif 
     111 
     112      !                            !-----------------------! 
     113      CALL opa_init                !==  Initialisations  ==! 
     114      !                            !-----------------------! 
    126115 
    127116      ! check that all process are still there... If some process have an error, 
     
    129118      IF( lk_mpp )   CALL mpp_max( nstop ) 
    130119 
     120      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA 
     121 
     122      !                            !-----------------------! 
     123      !                            !==   time stepping   ==! 
     124      !                            !-----------------------! 
    131125      istp = nit000 
    132       IF( lk_c1d ) THEN                 ! 1D configuration (no AGRIF zoom) 
    133          ! 
     126      IF( lk_c1d ) THEN                 !==  1D configuration  ==! 
    134127         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    135128            CALL stp_c1d( istp ) 
    136129            istp = istp + 1 
    137130         END DO 
    138       ELSE                              ! 3D ocean with or without AGRIF zoom 
    139          ! 
     131      ELSE                              !==  3D ocean with  ==! 
    140132         DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    141133#if defined key_agrif 
    142             CALL Agrif_Step( stp ) 
     134            CALL Agrif_Step( stp )           ! AGRIF: time stepping 
    143135#else 
    144             CALL stp( istp ) 
     136            CALL stp( istp )                 ! standard time stepping 
    145137#endif 
    146138            istp = istp + 1 
     
    148140         END DO 
    149141      ENDIF 
    150       !                                     ! ========= ! 
    151       !                                     !  Job end  ! 
    152       !                                     ! ========= ! 
    153  
    154       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    155  
    156       IF( nstop /= 0 .AND. lwp ) THEN                 ! error print 
     142        
     143      !                            !------------------------! 
     144      !                            !==  finalize the run  ==! 
     145      !                            !------------------------! 
     146      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA 
     147      ! 
     148      IF( nstop /= 0 .AND. lwp ) THEN   ! error print 
    157149         WRITE(numout,cform_err) 
    158150         WRITE(numout,*) nstop, ' error have been found'  
    159151      ENDIF 
    160  
     152      ! 
    161153      CALL opa_closefile 
    162154#if defined key_oasis3 || defined key_oasis4 
    163       call cpl_prism_finalize 
     155      CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
    164156#else 
    165       IF( lk_mpp )   CALL mppstop                          ! Close all files (mpp) 
     157      IF( lk_mpp )   CALL mppstop       ! end mpp communications 
    166158#endif 
    167159      ! 
     
    177169      !!---------------------------------------------------------------------- 
    178170#if defined key_oasis3 || defined key_oasis4 || defined key_iomput 
    179       INTEGER :: localComm 
     171      INTEGER :: ilocal_comm 
    180172#endif 
    181173      CHARACTER(len=80),dimension(10) ::   cltxt = '' 
    182       INTEGER                         :: ji             ! local loop indicees 
     174      INTEGER                         ::   ji   ! local loop indices 
     175      !! 
    183176      NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   & 
    184177         &             isplt , jsplt , njctls, njctle, nbench, nbit_cmp 
    185178      !!---------------------------------------------------------------------- 
    186  
    187       ! Namelist namctl : Control prints & Benchmark 
     179      ! 
     180      !                             ! open Namelist file 
    188181      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    189       READ  ( numnam, namctl ) 
    190  
     182      ! 
     183      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark 
     184      ! 
     185      !                             !--------------------------------------------! 
     186      !                             !  set communicator & select the local node  ! 
     187      !                             !--------------------------------------------! 
    191188#if defined key_iomput 
    192189# if defined key_oasis3 || defined key_oasis4 
    193       ! nemo local communicator given by oasis 
    194       CALL cpl_prism_init( localComm ) 
    195       ! io_server will get its communicators (if needed) from oasis (we don't see it) 
    196       CALL init_ioclient() 
     190      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     191      CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
    197192# else 
    198       ! nemo local communicator (used or not) given by the io_server 
    199       CALL init_ioclient( localcomm ) 
     193      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
    200194# endif 
    201       ! Nodes selection 
    202       narea = mynode( cltxt, localComm ) 
     195      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
     196 
    203197#else 
    204198# if defined key_oasis3 || defined key_oasis4 
    205       ! nemo local communicator given by oasis 
    206       CALL cpl_prism_init( localComm ) 
    207       ! Nodes selection 
    208       narea = mynode( cltxt, localComm ) 
     199      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     200      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt) 
    209201# else 
    210       ! Nodes selection 
    211       narea = mynode( cltxt ) 
     202      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt) 
    212203# endif 
    213204#endif 
    214       narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    215  
    216       lwp = narea == 1 .OR. ln_ctl   ! print control 
    217  
    218       IF( lwp ) THEN 
    219          ! open listing and namelist units 
     205      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 ) 
     206 
     207      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print 
     208 
     209      IF(lwp) THEN                            ! open listing units 
     210         ! 
    220211         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
    221           
    222          WRITE(numout,*) 
    223          WRITE(numout,*) '                 L O D Y C - I P S L' 
    224          WRITE(numout,*) '                     O P A model' 
     212         ! 
     213         WRITE(numout,*) 
     214         WRITE(numout,*) '         CNRS - NERC - Met OFFICE - MERCATOR-ocean' 
     215         WRITE(numout,*) '                       NEMO team' 
    225216         WRITE(numout,*) '            Ocean General Circulation Model' 
    226          WRITE(numout,*) '               version OPA 9.0  (2005) ' 
    227          WRITE(numout,*) 
    228          WRITE(numout,*) 
    229          DO ji = 1, SIZE(cltxt) 
    230             IF (TRIM(cltxt(ji)) /= '') WRITE(numout,*) cltxt(ji) 
     217         WRITE(numout,*) '                  version 3.2  (2009) ' 
     218         WRITE(numout,*) 
     219         WRITE(numout,*) 
     220         DO ji = 1, SIZE(cltxt)  
     221            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
    231222         END DO 
    232  
    233       ENDIF 
    234  
    235       !                                     ! ============================== ! 
    236       !                                     !  Model general initialization  ! 
    237       !                                     ! ============================== ! 
    238  
    239       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
     223         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
     224         ! 
     225      ENDIF 
     226      !                             !--------------------------------! 
     227      !                             !  Model general initialization  ! 
     228      !                             !--------------------------------! 
    240229 
    241230      CALL opa_flg                          ! Control prints & Benchmark 
    242231 
    243232                                            ! Domain decomposition 
    244       IF( jpni*jpnj == jpnij ) THEN 
    245          CALL mpp_init                          ! standard cutting out 
    246       ELSE 
    247          CALL mpp_init2                         ! eliminate land processors 
     233      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
     234      ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
    248235      ENDIF 
    249236       
    250237      CALL phy_cst                          ! Physical constants 
    251  
    252238      CALL eos_init                         ! Equation of state 
    253  
    254239      CALL dom_cfg                          ! Domain configuration 
    255        
    256240      CALL dom_init                         ! Domain 
    257  
    258       IF( lk_c1d    ) THEN                      ! adaptation for 1D configuration  
    259          CALL cor_c1d                                ! redefine Coriolis at T-point 
    260          umask(:,:,:) = tmask(:,:,:)                 ! U, V and T-points are the same 
    261          vmask(:,:,:) = tmask(:,:,:)                 !  
    262       ENDIF 
    263  
    264       IF( ln_ctl    )   CALL prt_ctl_init   ! Print control 
    265  
    266       IF( lk_obc    )   CALL obc_init       ! Open boundaries  
    267  
    268       IF( lk_bdy    )   CALL bdy_init       ! Unstructured open boundaries 
     241!!gm c1d case can be moved in dom_init routine 
     242      IF( lk_c1d ) THEN                          ! 1D configuration  
     243         CALL cor_c1d                            ! Coriolis defined at T-point 
     244         umask(:,:,:) = tmask(:,:,:)             ! U, V and T-points are the same 
     245         vmask(:,:,:) = tmask(:,:,:)             !  
     246      ENDIF 
     247!!gm c1d end 
     248 
     249      IF( ln_ctl )   CALL prt_ctl_init      ! Print control 
     250 
     251      IF( lk_obc )   CALL obc_init          ! Open boundaries  
     252      IF( lk_bdy )   CALL bdy_init          ! Unstructured open boundaries 
    269253 
    270254      CALL istate_init                      ! ocean initial state (Dynamics and tracers) 
    271255 
    272256      !                                     ! Ocean physics 
    273  
    274257      CALL ldf_dyn_init                         ! Lateral ocean momentum physics 
    275  
    276258      CALL ldf_tra_init                         ! Lateral ocean tracer physics 
    277  
    278259      CALL zdf_init                             ! Vertical ocean physics 
    279260 
     261      CALL trc_ini                          ! Passive tracers 
     262 
     263      !                                     ! diagnostics 
     264      CALL iom_init( fjulday - adatrj )         ! iom_put initialization 
     265      CALL dia_ptr_init                         ! Poleward TRansports initialization 
    280266      CALL trd_mod_init                         ! Mixed-layer/Vorticity/Integral constraints trends 
    281  
    282  
    283 #if defined key_top 
    284       CALL trc_ini                          ! Passive tracers 
    285 #endif 
    286  
    287       CALL dia_ptr_init                     ! Poleward TRansports initialization 
    288  
    289       CALL iom_init( fjulday - adatrj )     ! iom_put initialization 
    290  
    291       !                                     ! =============== ! 
    292       !                                     !  time stepping  ! 
    293       !                                     ! =============== ! 
    294  
    295       IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    296  
     267      ! 
    297268   END SUBROUTINE opa_init 
    298269 
     
    302273      !!                     ***  ROUTINE opa  *** 
    303274      !! 
    304       !! ** Purpose :   Initialize logical flags that control the choice of 
    305       !!      some algorithm or control print 
    306       !! 
    307       !! ** Method  :    Read in namilist namflg logical flags 
    308       !! 
    309       !! History : 
    310       !!   9.0  !  03-11  (G. Madec)  Original code 
    311       !!---------------------------------------------------------------------- 
    312       !! * Local declarations 
    313  
     275      !! ** Purpose :   Initialise logical flags that control the choice of 
     276      !!              some algorithm or control print 
     277      !! 
     278      !! ** Method  : - print namctl information 
     279      !!              - Read in namilist namflg logical flags 
     280      !!---------------------------------------------------------------------- 
    314281      NAMELIST/namflg/ ln_dynhpg_imp, nn_dynhpg_rst 
    315282      !!---------------------------------------------------------------------- 
    316283 
    317       ! Parameter control and print 
    318       ! --------------------------- 
    319       IF(lwp) THEN 
     284      IF(lwp) THEN                ! Parameter print 
    320285         WRITE(numout,*) 
    321286         WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 
    322287         WRITE(numout,*) '~~~~~~~ ' 
    323          WRITE(numout,*) '          Namelist namctl' 
    324          WRITE(numout,*) '             run control (for debugging)     ln_ctl    = ', ln_ctl 
    325          WRITE(numout,*) '             level of print                  nprint    = ', nprint 
    326          WRITE(numout,*) '             Start i indice for SUM control  nictls    = ', nictls 
    327          WRITE(numout,*) '             End i indice for SUM control    nictle    = ', nictle 
    328          WRITE(numout,*) '             Start j indice for SUM control  njctls    = ', njctls 
    329          WRITE(numout,*) '             End j indice for SUM control    njctle    = ', njctle 
    330          WRITE(numout,*) '             number of proc. following i     isplt     = ', isplt 
    331          WRITE(numout,*) '             number of proc. following j     jsplt     = ', jsplt 
    332          WRITE(numout,*) '             benchmark parameter (0/1)       nbench    = ', nbench 
    333          WRITE(numout,*) '             bit comparison mode (0/1)       nbit_cmp  = ', nbit_cmp 
    334       ENDIF 
    335  
    336       ! ... Control the sub-domain area indices for the control prints 
    337       IF( ln_ctl )   THEN 
    338          IF( lk_mpp )   THEN 
    339             ! the domain is forced to the real splitted domain in MPI 
    340             isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 
     288         WRITE(numout,*) '   Namelist namctl' 
     289         WRITE(numout,*) '      run control (for debugging)     ln_ctl    = ', ln_ctl 
     290         WRITE(numout,*) '      level of print                  nprint    = ', nprint 
     291         WRITE(numout,*) '      Start i indice for SUM control  nictls    = ', nictls 
     292         WRITE(numout,*) '      End i indice for SUM control    nictle    = ', nictle 
     293         WRITE(numout,*) '      Start j indice for SUM control  njctls    = ', njctls 
     294         WRITE(numout,*) '      End j indice for SUM control    njctle    = ', njctle 
     295         WRITE(numout,*) '      number of proc. following i     isplt     = ', isplt 
     296         WRITE(numout,*) '      number of proc. following j     jsplt     = ', jsplt 
     297         WRITE(numout,*) '      benchmark parameter (0/1)       nbench    = ', nbench 
     298         WRITE(numout,*) '      bit comparison mode (0/1)       nbit_cmp  = ', nbit_cmp 
     299      ENDIF 
     300 
     301      !                           ! Parameter control 
     302      ! 
     303      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints 
     304         IF( lk_mpp ) THEN 
     305            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real splitted domain 
    341306         ELSE 
    342307            IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    343                CALL ctl_warn( '          - isplt & jsplt are equal to 1',   & 
    344                     &         '          - the print control will be done over the whole domain' ) 
    345             ENDIF 
    346  
    347             ! compute the total number of processors ijsplt 
    348             ijsplt = isplt*jsplt 
     308               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
     309                  &           ' - the print control will be done over the whole domain' ) 
     310            ENDIF 
     311            ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    349312         ENDIF 
    350  
    351313         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    352314         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    353  
    354          ! Control the indices used for the SUM control 
    355          IF( nictls+nictle+njctls+njctle == 0 )   THEN 
    356             ! the print control is done over the default area 
    357             lsp_area = .FALSE. 
    358          ELSE 
    359             ! the print control is done over a specific  area 
     315         ! 
     316         !                              ! indices used for the SUM control 
     317         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
     318            lsp_area = .FALSE.                         
     319         ELSE                                             ! print control done over a specific  area 
    360320            lsp_area = .TRUE. 
    361321            IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
     
    363323               nictls = 1 
    364324            ENDIF 
    365  
    366325            IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    367326               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    368327               nictle = jpiglo 
    369328            ENDIF 
    370  
    371329            IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    372330               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    373331               njctls = 1 
    374332            ENDIF 
    375  
    376333            IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    377334               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    378335               njctle = jpjglo 
    379336            ENDIF 
    380  
    381          ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 ) 
    382        ENDIF            ! IF(ln_ctl) 
    383  
    384       IF( nbench == 1 )   THEN 
     337         ENDIF 
     338      ENDIF 
     339 
     340      IF( nbench == 1 )   THEN            ! Benchmark  
    385341         SELECT CASE ( cp_cfg ) 
    386          CASE ( 'gyre' ) 
    387             CALL ctl_warn( '          The Benchmark is activated ' ) 
    388          CASE DEFAULT 
    389             CALL ctl_stop( '          The Benchmark is based on the GYRE configuration: key_gyre must & 
    390                &                      be used or set nbench = 0' ) 
     342         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
     343         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
     344            &                                 ' key_gyre must be used or set nbench = 0' ) 
    391345         END SELECT 
    392346      ENDIF 
    393347 
    394       IF( nbit_cmp == 1 )   THEN 
    395          CALL ctl_warn( '          Bit comparison enabled. Single and multiple processor results must bit compare', & 
    396               &         '          WARNING: RESULTS ARE NOT PHYSICAL.' ) 
    397       ENDIF 
    398  
    399  
    400       ! Read Namelist namflg : algorithm FLaG 
    401       ! -------------------- 
    402       REWIND ( numnam ) 
    403       READ   ( numnam, namflg ) 
    404  
    405       ! Parameter control and print 
    406       ! --------------------------- 
    407       IF(lwp) THEN 
     348      IF( nbit_cmp == 1 )   THEN          ! Bit compare 
     349         CALL ctl_warn( ' Bit comparison enabled. Single and multiple processor results must bit compare', & 
     350              &         ' WARNING: RESULTS ARE NOT PHYSICAL.' ) 
     351      ENDIF 
     352 
     353 
     354      REWIND( numnam )            ! Read Namelist namflg : algorithm FLaG 
     355      READ  ( numnam, namflg ) 
     356 
     357      IF(lwp) THEN                ! Parameter print 
    408358         WRITE(numout,*) 
    409359         WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm' 
    410360         WRITE(numout,*) '~~~~~~~' 
    411          WRITE(numout,*) '          Namelist namflg : set algorithm flags' 
    412          WRITE(numout,*) '             centered (F) or semi-implicit (T)   ln_dynhpg_imp = ', ln_dynhpg_imp 
    413          WRITE(numout,*) '             hydrostatic pressure gradient' 
    414          WRITE(numout,*) '             add dynhpg implicit variable        nn_dynhpg_rst = ', nn_dynhpg_rst 
    415          WRITE(numout,*) '             in restart ot not nn_dynhpg_rst' 
    416       ENDIF 
     361         WRITE(numout,*) '   Namelist namflg : hydrostatic pressure gradient time stepping' 
     362         WRITE(numout,*) '      centered (F) or semi-implicit (T)        ln_dynhpg_imp = ', ln_dynhpg_imp 
     363         WRITE(numout,*) '      ensure restartability (=1) or not (=0)   nn_dynhpg_rst = ', nn_dynhpg_rst 
     364      ENDIF 
     365      ! 
    417366      IF( .NOT. ln_dynhpg_imp )   nn_dynhpg_rst = 0      ! force no adding dynhpg implicit variables in restart 
    418  
     367      ! 
    419368   END SUBROUTINE opa_flg 
    420369 
     
    425374      !! 
    426375      !! ** Purpose :   Close the files 
    427       !! 
    428       !! ** Method  : 
    429       !! 
    430       !! History : 
    431       !!   9.0  !  05-01  (O. Le Galloudec)  Original code 
    432       !!---------------------------------------------------------------------- 
    433       !! * Modules used 
     376      !!---------------------------------------------------------------------- 
    434377      USE dtatem        ! temperature data 
    435378      USE dtasal        ! salinity data 
    436379      !!---------------------------------------------------------------------- 
    437  
    438       IF ( lk_mpp ) CALL mppsync 
    439  
     380      ! 
     381      IF( lk_mpp )  CALL mppsync 
     382      ! 
    440383      CLOSE( numnam )           ! namelist 
    441384      CLOSE( numout )           ! standard model output file 
    442  
     385      ! 
    443386      IF(lwp) CLOSE( numstp )   ! time-step file 
    444387      IF(lwp) CLOSE( numsol )   ! solver file 
    445  
     388      ! 
    446389      CALL iom_close            ! close all input/output files 
    447  
     390      ! 
    448391   END SUBROUTINE opa_closefile 
    449392 
Note: See TracChangeset for help on using the changeset viewer.