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 13540 for NEMO/branches/2020/r12377_ticket2386/src/OCE/nemogcm.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (3 years ago)
Author:
andmirek
Message:

Ticket #2386: update to latest trunk

Location:
NEMO/branches/2020/r12377_ticket2386
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r12377_ticket2386

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13507        sette 
  • NEMO/branches/2020/r12377_ticket2386/src/OCE/nemogcm.F90

    r12511 r13540  
    4747   USE usrdef_nam     ! user defined configuration 
    4848   USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdy_oce,  ONLY : ln_bdy 
    5049   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    5150   USE istate         ! initial state setting          (istate_init routine) 
     
    6059   USE diacfl         ! CFL diagnostics               (dia_cfl_init routine) 
    6160   USE diamlr         ! IOM context management for multiple-linear-regression analysis 
     61#if defined key_qco 
     62   USE stepMLF        ! NEMO time-stepping               (stp_MLF   routine) 
     63#else 
    6264   USE step           ! NEMO time-stepping                 (stp     routine) 
     65#endif 
    6366   USE isfstp         ! ice shelf                     (isf_stp_init routine) 
    6467   USE icbini         ! handle bergs, initialisation 
     
    8487#endif 
    8588   ! 
     89   USE prtctl         ! Print control 
     90   USE in_out_manager ! I/O manager 
    8691   USE lib_mpp        ! distributed memory computing 
    8792   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    88    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     93   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    8994   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    9095#if defined key_iomput 
     
    9499   USE agrif_all_update   ! Master Agrif update 
    95100#endif 
     101   USE halo_mng 
    96102 
    97103   IMPLICIT NONE 
     
    142148#if defined key_agrif 
    143149      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    144       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    145       CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     150      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA 
    146151# if defined key_top 
    147152      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    148 # endif 
    149 # if defined key_si3 
    150       CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice 
    151153# endif 
    152154#endif 
     
    181183      ! 
    182184      DO WHILE( istp <= nitend .AND. nstop == 0 ) 
     185#if defined key_qco 
     186         CALL stp_MLF 
     187#else 
    183188         CALL stp 
     189#endif 
    184190         istp = istp + 1 
    185191      END DO 
    186       ! 
    187       IF( .NOT. Agrif_Root() ) THEN 
    188          CALL Agrif_ParentGrid_To_ChildGrid() 
    189          IF( ln_diaobs )   CALL dia_obs_wri 
    190          IF( ln_timing )   CALL timing_finalize 
    191          CALL Agrif_ChildGrid_To_ParentGrid() 
    192       ENDIF 
    193192      ! 
    194193# else 
     
    205204            ENDIF 
    206205             
     206#if defined key_qco 
     207            CALL stp_MLF      ( istp ) 
     208#else 
    207209            CALL stp        ( istp )  
     210#endif 
    208211            istp = istp + 1 
    209212 
     
    236239      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    237240         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    238          CALL ctl_stop( ctmp1 ) 
     241         IF( ngrdstop > 0 ) THEN 
     242            WRITE(ctmp9,'(i2)') ngrdstop 
     243            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     244            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     245            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
     246         ELSE 
     247            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     248            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
     249         ENDIF 
    239250      ENDIF 
    240251      ! 
     
    248259#else 
    249260      IF    ( lk_oasis ) THEN   ;   CALL cpl_finalize   ! end coupling and mpp communications with OASIS 
    250       ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications 
     261      ELSEIF( lk_mpp   ) THEN   ;   CALL mppstop        ! end mpp communications 
    251262      ENDIF 
    252263#endif 
     
    269280      INTEGER ::   ios, ilocal_comm   ! local integers 
    270281      !! 
    271       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    272          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    273          &             ln_timing, ln_diacfl 
     282      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     283         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    274284      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    275285      !!---------------------------------------------------------------------- 
     
    317327      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    318328      ! open /dev/null file to be able to supress output write easily 
     329      IF( Agrif_Root() ) THEN 
    319330                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    320       ! 
     331#ifdef key_agrif 
     332      ELSE 
     333                  numnul = Agrif_Parent(numnul)    
     334#endif 
     335      ENDIF 
    321336      !                             !--------------------! 
    322337      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp 
     
    329344      ! 
    330345      ! finalize the definition of namctl variables 
    331       IF( sn_cfctl%l_allon ) THEN 
    332          ! Turn on all options. 
    333          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    334          ! Ensure all processors are active 
    335          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    336       ELSEIF( sn_cfctl%l_config ) THEN 
    337          ! Activate finer control of report outputs 
    338          ! optionally switch off output from selected areas (note this only 
    339          ! applies to output which does not involve global communications) 
    340          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    341            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    342            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    343       ELSE 
    344          ! turn off all options. 
    345          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    346       ENDIF 
     346      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     347         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    347348      ! 
    348349      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
     
    373374         WRITE(numout,*) "     ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 
    374375         WRITE(numout,*) 
     376          
     377         ! Print the working precision to ocean.output 
     378         IF (wp == dp) THEN 
     379            WRITE(numout,*) "Working precision = double-precision" 
     380         ELSE 
     381            WRITE(numout,*) "Working precision = single-precision" 
     382         ENDIF 
     383         WRITE(numout,*) 
    375384         ! 
    376385         WRITE(numout,cform_aaa)                                        ! Flag AAAAAAA 
     
    390399      ! 
    391400      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    392          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     401         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    393402      ELSE                              ! user-defined namelist 
    394          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     403         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    395404      ENDIF 
    396405      ! 
     
    402411      CALL mpp_init 
    403412 
     413      CALL halo_mng_init() 
    404414      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    405415      CALL nemo_alloc() 
     
    407417      ! Initialise time level indices 
    408418      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    409  
     419#if defined key_agrif 
     420      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     421#endif  
    410422      !                             !-------------------------------! 
    411423      !                             !  NEMO general initialization  ! 
     
    422434      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration 
    423435                           CALL     wad_init        ! Wetting and drying options 
     436 
     437#if defined key_agrif 
     438     CALL Agrif_Declare_Var_ini   !  "      "   "   "      "  DOM 
     439#endif 
    424440                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
    425441      IF( ln_crs       )   CALL     crs_init(      Nnn )       ! coarsened grid: domain initialization  
     
    443459      ENDIF 
    444460      ! 
    445        
     461 
    446462                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
    447463 
     
    528544         WRITE(numout,*) '~~~~~~~~' 
    529545         WRITE(numout,*) '   Namelist namctl' 
    530          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    531          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    532          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    533546         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    534547         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
     
    542555         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    543556         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    544          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    545          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    546          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    547          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    548          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    549          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    550          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    551557         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    552558         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    553559      ENDIF 
    554560      ! 
    555       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    556       nictls    = nn_ictls 
    557       nictle    = nn_ictle 
    558       njctls    = nn_jctls 
    559       njctle    = nn_jctle 
    560       isplt     = nn_isplt 
    561       jsplt     = nn_jsplt 
    562  
     561      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    563562      IF(lwp) THEN                  ! control print 
    564563         WRITE(numout,*) 
     
    571570         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    572571      ENDIF 
    573       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    574       ! 
    575       !                             ! Parameter control 
    576       ! 
    577       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    578          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    579             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    580          ELSE 
    581             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    582                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    583                   &           ' - the print control will be done over the whole domain' ) 
    584             ENDIF 
    585             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    586          ENDIF 
    587          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    588          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    589          ! 
    590          !                              ! indices used for the SUM control 
    591          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    592             lsp_area = .FALSE. 
    593          ELSE                                             ! print control done over a specific  area 
    594             lsp_area = .TRUE. 
    595             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    596                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    597                nictls = 1 
    598             ENDIF 
    599             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    600                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    601                nictle = jpiglo 
    602             ENDIF 
    603             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    604                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    605                njctls = 1 
    606             ENDIF 
    607             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    608                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    609                njctle = jpjglo 
    610             ENDIF 
    611          ENDIF 
    612       ENDIF 
    613572      ! 
    614573      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 
     
    678637 
    679638    
    680    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     639   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    681640      !!---------------------------------------------------------------------- 
    682641      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    683642      !! 
    684643      !! ** Purpose :   Set elements of the output control structure to setto. 
    685       !!                for_all should be .false. unless all areas are to be 
    686       !!                treated identically. 
    687644      !! 
    688645      !! ** Method  :   Note this routine can be used to switch on/off some 
    689       !!                types of output for selected areas but any output types 
    690       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    691       !!                should be protected from selective switching by the 
    692       !!                for_all argument 
    693       !!---------------------------------------------------------------------- 
    694       LOGICAL :: setto, for_all 
    695       TYPE(sn_ctl) :: sn_cfctl 
    696       !!---------------------------------------------------------------------- 
    697       IF( for_all ) THEN 
    698          sn_cfctl%l_runstat = setto 
    699          sn_cfctl%l_trcstat = setto 
    700       ENDIF 
     646      !!                types of output for selected areas. 
     647      !!---------------------------------------------------------------------- 
     648      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     649      LOGICAL     , INTENT(in   ) :: setto 
     650      !!---------------------------------------------------------------------- 
     651      sn_cfctl%l_runstat = setto 
     652      sn_cfctl%l_trcstat = setto 
    701653      sn_cfctl%l_oceout  = setto 
    702654      sn_cfctl%l_layout  = setto 
     
    708660   !!====================================================================== 
    709661END MODULE nemogcm 
    710  
Note: See TracChangeset for help on using the changeset viewer.