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 12149 for NEMO/branches/2019/ENHANCE-03_closea/src/OCE/nemogcm.F90 – NEMO

Ignore:
Timestamp:
2019-12-10T15:03:24+01:00 (4 years ago)
Author:
ayoung
Message:

Updated trunk to 12072

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/ENHANCE-03_closea/src/OCE/nemogcm.F90

    r10588 r12149  
    5959   USE diaobs         ! Observation diagnostics       (dia_obs_init routine) 
    6060   USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
     61   USE diaharm        ! tidal harmonics diagnostics  (dia_harm_init routine) 
    6162   USE step           ! NEMO time-stepping                 (stp     routine) 
    6263   USE icbini         ! handle bergs, initialisation 
     
    103104 
    104105#if defined key_mpp_mpi 
     106   ! need MPI_Wtime 
    105107   INCLUDE 'mpif.h' 
    106108#endif 
     
    128130      !!---------------------------------------------------------------------- 
    129131      INTEGER ::   istp   ! time step index 
     132      REAL(wp)::   zstptiming   ! elapsed time for 1 time step 
    130133      !!---------------------------------------------------------------------- 
    131134      ! 
     
    188191         ! 
    189192         DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    190 #if defined key_mpp_mpi 
     193 
    191194            ncom_stp = istp 
    192             IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime() 
    193             IF ( istp ==         nitend ) elapsed_time = MPI_Wtime() - elapsed_time 
    194 #endif 
     195            IF( ln_timing ) THEN 
     196               zstptiming = MPI_Wtime() 
     197               IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming 
     198               IF ( istp ==         nitend ) elapsed_time = zstptiming - elapsed_time 
     199            ENDIF 
     200             
    195201            CALL stp        ( istp )  
    196202            istp = istp + 1 
     203 
     204            IF( lwp .AND. ln_timing )   WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 
     205 
    197206         END DO 
    198207         ! 
     
    220229      ! 
    221230      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    222          WRITE(numout,cform_err) 
    223          WRITE(numout,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    224          WRITE(numout,*) 
     231         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
     232         CALL ctl_stop( ctmp1 ) 
    225233      ENDIF 
    226234      ! 
     
    234242#else 
    235243      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS 
    236       ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop( ldfinal = .TRUE. )   ! end mpp communications 
     244      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications 
    237245      ENDIF 
    238246#endif 
     
    240248      IF(lwm) THEN 
    241249         IF( nstop == 0 ) THEN   ;   STOP 0 
    242          ELSE                    ;   STOP 999 
     250         ELSE                    ;   STOP 123 
    243251         ENDIF 
    244252      ENDIF 
     
    253261      !! ** Purpose :   initialization of the NEMO GCM 
    254262      !!---------------------------------------------------------------------- 
    255       INTEGER  ::   ji                 ! dummy loop indices 
    256       INTEGER  ::   ios, ilocal_comm   ! local integers 
    257       CHARACTER(len=120), DIMENSION(60) ::   cltxt, cltxt2, clnam 
     263      INTEGER ::   ios, ilocal_comm   ! local integers 
    258264      !! 
    259265      NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   & 
     
    263269      !!---------------------------------------------------------------------- 
    264270      ! 
    265       cltxt  = '' 
    266       cltxt2 = '' 
    267       clnam  = ''   
    268271      cxios_context = 'nemo' 
    269272      ! 
    270       !                             ! Open reference namelist and configuration namelist files 
    271       CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    272       CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    273       ! 
    274       REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
    275       READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    276 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 
    277       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    278       READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    279 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 
    280       ! 
    281       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
    282       READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    283 903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 
    284       REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
    285       READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    286 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    287  
    288       !                             !--------------------------! 
    289       !                             !  Set global domain size  !   (control print return in cltxt2) 
    290       !                             !--------------------------! 
    291       IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
    292          CALL domain_cfg ( cltxt2,        cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    293          ! 
    294       ELSE                                ! user-defined namelist 
    295          CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
    296       ENDIF 
    297       ! 
    298       ! 
    299       !                             !--------------------------------------------! 
    300       !                             !  set communicator & select the local node  ! 
    301       !                             !  NB: mynode also opens output.namelist.dyn ! 
    302       !                             !      on unit number numond on first proc   ! 
    303       !                             !--------------------------------------------! 
     273      !                             !-------------------------------------------------! 
     274      !                             !     set communicator & select the local rank    ! 
     275      !                             !  must be done as soon as possible to get narea  ! 
     276      !                             !-------------------------------------------------! 
     277      ! 
    304278#if defined key_iomput 
    305279      IF( Agrif_Root() ) THEN 
    306280         IF( lk_oasis ) THEN 
    307281            CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
    308             CALL xios_initialize( "not used"       ,local_comm= ilocal_comm )    ! send nemo communicator to xios 
     282            CALL xios_initialize( "not used"       , local_comm =ilocal_comm )   ! send nemo communicator to xios 
    309283         ELSE 
    310             CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )    ! nemo local communicator given by xios 
     284            CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )   ! nemo local communicator given by xios 
    311285         ENDIF 
    312286      ENDIF 
    313       ! Nodes selection (control print return in cltxt) 
    314       narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
     287      CALL mpp_start( ilocal_comm ) 
    315288#else 
    316289      IF( lk_oasis ) THEN 
     
    318291            CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
    319292         ENDIF 
    320          ! Nodes selection (control print return in cltxt) 
    321          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 
     293         CALL mpp_start( ilocal_comm ) 
    322294      ELSE 
    323          ilocal_comm = 0                                    ! Nodes selection (control print return in cltxt) 
    324          narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop ) 
    325       ENDIF 
    326 #endif 
    327  
    328       narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 ) 
    329  
    330       IF( sn_cfctl%l_config ) THEN 
    331          ! Activate finer control of report outputs 
    332          ! optionally switch off output from selected areas (note this only 
    333          ! applies to output which does not involve global communications) 
    334          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    335            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    336            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    337       ELSE 
    338          ! Use ln_ctl to turn on or off all options. 
    339          CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
    340       ENDIF 
    341  
    342       lwm = (narea == 1)                                    ! control of output namelists 
    343       lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print 
    344  
    345       IF(lwm) THEN               ! write merged namelists from earlier to output namelist  
    346          !                       ! now that the file has been opened in call to mynode.  
    347          !                       ! NB: nammpp has already been written in mynode (if lk_mpp_mpi) 
    348          WRITE( numond, namctl ) 
    349          WRITE( numond, namcfg ) 
    350          IF( .NOT.ln_read_cfg ) THEN 
    351             DO ji = 1, SIZE(clnam) 
    352                IF( TRIM(clnam(ji)) /= '' )   WRITE(numond, * ) clnam(ji)     ! namusr_def print 
    353             END DO 
    354          ENDIF 
    355       ENDIF 
    356  
    357       IF(lwp) THEN                            ! open listing units 
    358          ! 
    359          CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     295         CALL mpp_start( ) 
     296      ENDIF 
     297#endif 
     298      ! 
     299      narea = mpprank + 1               ! mpprank: the rank of proc (0 --> mppsize -1 ) 
     300      lwm = (narea == 1)                ! control of output namelists 
     301      ! 
     302      !                             !---------------------------------------------------------------! 
     303      !                             ! Open output files, reference and configuration namelist files ! 
     304      !                             !---------------------------------------------------------------! 
     305      ! 
     306      ! open ocean.output as soon as possible to get all output prints (including errors messages) 
     307      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     308      ! open reference and configuration namelist files 
     309                  CALL ctl_opn( numnam_ref,        'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     310                  CALL ctl_opn( numnam_cfg,        'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     311      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     312      ! open /dev/null file to be able to supress output write easily 
     313                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     314      ! 
     315      !                             !--------------------! 
     316      !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp 
     317      !                             !--------------------! 
     318      ! 
     319      REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
     320      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
     321901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' ) 
     322      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
     323      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
     324902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 
     325      ! 
     326      lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print 
     327      ! 
     328      IF(lwp) THEN                      ! open listing units 
     329         ! 
     330         IF( .NOT. lwm )   &            ! alreay opened for narea == 1 
     331            &            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 
    360332         ! 
    361333         WRITE(numout,*) 
    362          WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC' 
     334         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
    363335         WRITE(numout,*) '                       NEMO team' 
    364336         WRITE(numout,*) '            Ocean General Circulation Model' 
     
    379351         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    380352         WRITE(numout,*) 
    381           
    382          DO ji = 1, SIZE(cltxt) 
    383             IF( TRIM(cltxt (ji)) /= '' )   WRITE(numout,*) TRIM(cltxt(ji))    ! control print of mynode 
    384          END DO 
    385          WRITE(numout,*) 
    386          WRITE(numout,*) 
    387          DO ji = 1, SIZE(cltxt2) 
    388             IF( TRIM(cltxt2(ji)) /= '' )   WRITE(numout,*) TRIM(cltxt2(ji))   ! control print of domain size 
    389          END DO 
    390353         ! 
    391354         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
    392355         ! 
    393356      ENDIF 
    394       ! open /dev/null file to be able to supress output write easily 
    395       CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
    396       ! 
    397       !                                      ! Domain decomposition 
    398       CALL mpp_init                          ! MPP 
     357      ! 
     358      ! finalize the definition of namctl variables 
     359      IF( sn_cfctl%l_config ) THEN 
     360         ! Activate finer control of report outputs 
     361         ! optionally switch off output from selected areas (note this only 
     362         ! applies to output which does not involve global communications) 
     363         IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
     364           & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
     365           &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
     366      ELSE 
     367         ! Use ln_ctl to turn on or off all options. 
     368         CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
     369      ENDIF 
     370      ! 
     371      IF(lwm) WRITE( numond, namctl ) 
     372      ! 
     373      !                             !------------------------------------! 
     374      !                             !  Set global domain size parameters ! 
     375      !                             !------------------------------------! 
     376      ! 
     377      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
     378      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
     379903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
     380      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
     381      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
     382904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     383      ! 
     384      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
     385         CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     386      ELSE                              ! user-defined namelist 
     387         CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     388      ENDIF 
     389      ! 
     390      IF(lwm)   WRITE( numond, namcfg ) 
     391      ! 
     392      !                             !-----------------------------------------! 
     393      !                             ! mpp parameters and domain decomposition ! 
     394      !                             !-----------------------------------------! 
     395      CALL mpp_init 
    399396 
    400397      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
     
    480477      
    481478      !                                      ! Diagnostics 
    482       IF( lk_floats    )   CALL     flo_init    ! drifting Floats 
     479                           CALL     flo_init    ! drifting Floats 
    483480      IF( ln_diacfl    )   CALL dia_cfl_init    ! Initialise CFL diagnostics 
    484481                           CALL dia_ptr_init    ! Poleward TRansports initialization 
    485       IF( lk_diadct    )   CALL dia_dct_init    ! Sections tranports 
     482                           CALL dia_dct_init    ! Sections tranports 
    486483                           CALL dia_hsb_init    ! heat content, salt content and volume budgets 
    487484                           CALL     trd_init    ! Mixed-layer/Vorticity/Integral constraints trends 
     
    489486                           CALL dia_tmb_init    ! TMB outputs 
    490487                           CALL dia_25h_init    ! 25h mean  outputs 
    491       IF( ln_diaobs    )   CALL dia_obs( nit000-1 )   ! Observation operator for restart 
     488                           CALL dia_harm_init   ! tidal harmonics outputs 
     489     IF( ln_diaobs    )    CALL dia_obs( nit000-1 )   ! Observation operator for restart 
    492490 
    493491      !                                      ! Assimilation increments 
     
    507505      !! ** Purpose :   control print setting 
    508506      !! 
    509       !! ** Method  : - print namctl information and check some consistencies 
     507      !! ** Method  : - print namctl and namcfg information and check some consistencies 
    510508      !!---------------------------------------------------------------------- 
    511509      ! 
     
    650648      USE trc_oce   , ONLY : trc_oce_alloc 
    651649      USE bdy_oce   , ONLY : bdy_oce_alloc 
    652 #if defined key_diadct  
    653       USE diadct    , ONLY : diadct_alloc  
    654 #endif  
    655650      ! 
    656651      INTEGER :: ierr 
     
    664659      ierr = ierr + bdy_oce_alloc()    ! bdy masks (incl. initialization) 
    665660      ! 
    666 #if defined key_diadct  
    667       ierr = ierr + diadct_alloc ()    !  
    668 #endif  
    669       ! 
    670661      CALL mpp_sum( 'nemogcm', ierr ) 
    671662      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) 
     
    673664   END SUBROUTINE nemo_alloc 
    674665 
     666    
    675667   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
    676668      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.