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/SAS/nemogcm.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (4 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/SAS/nemogcm.F90

    r12511 r13540  
    3535   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    3636   ! 
     37   USE prtctl         ! Print control 
     38   USE in_out_manager ! I/O manager 
    3739   USE lib_mpp        ! distributed memory computing 
    3840   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    39    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop  ! Setup of north fold exchanges 
     41   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges 
    4042   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    4143#if defined key_iomput 
    … …  
    4547   USE agrif_ice_update ! ice update 
    4648#endif 
     49   USE halo_mng 
    4750 
    4851   IMPLICIT NONE 
    … …  
    9093#if defined key_agrif 
    9194      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    92       CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    9395      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    9496# if defined key_top 
    9597      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
    9698# endif 
    97 # if defined key_si3 
    98       CALL Agrif_Declare_Var_ice   !  "      "   "   "      "  Sea ice 
    99 # endif 
    10099#endif 
    101100      ! check that all process are still there... If some process have an error, 
    … …  
    124123         istp = istp + 1 
    125124      END DO 
    126       ! 
    127       IF( .NOT. Agrif_Root() ) THEN 
    128          CALL Agrif_ParentGrid_To_ChildGrid() 
    129          IF( ln_timing )   CALL timing_finalize 
    130          CALL Agrif_ChildGrid_To_ParentGrid() 
    131       ENDIF 
    132125      ! 
    133126#else 
    … …  
    165158      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    166159         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    167          CALL ctl_stop( ctmp1 ) 
     160         IF( ngrdstop > 0 ) THEN 
     161            WRITE(ctmp9,'(i2)') ngrdstop 
     162            WRITE(ctmp2,*) '           E R R O R detected in Agrif grid '//TRIM(ctmp9) 
     163            WRITE(ctmp3,*) '           Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 
     164            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 
     165         ELSE 
     166            WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     167            CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
     168         ENDIF 
    168169      ENDIF 
    169170      ! 
    … …  
    198199      INTEGER ::   ios, ilocal_comm   ! local integers 
    199200      !! 
    200       NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              & 
    201          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    202          &             ln_timing, ln_diacfl 
     201      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     202         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    203203      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    204204      !!---------------------------------------------------------------------- 
    … …  
    207207      ELSE                  ;   cxios_context = 'nemo' 
    208208      ENDIF 
     209      nn_hls = 1 
    209210      ! 
    210211      !                             !-------------------------------------------------! 
    … …  
    256257      ENDIF 
    257258      ! open /dev/null file to be able to supress output write easily 
     259      IF( Agrif_Root() ) THEN 
    258260                     CALL ctl_opn(     numnul,               '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     261#ifdef key_agrif 
     262      ELSE 
     263                  numnul = Agrif_Parent(numnul)    
     264#endif 
     265      ENDIF 
    259266      ! 
    260267      !                             !--------------------! 
    … …  
    268275      ! 
    269276      ! finalize the definition of namctl variables 
    270       IF( sn_cfctl%l_allon ) THEN 
    271          ! Turn on all options. 
    272          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    273          ! Ensure all processors are active 
    274          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    275       ELSEIF( sn_cfctl%l_config ) THEN 
    276          ! Activate finer control of report outputs 
    277          ! optionally switch off output from selected areas (note this only 
    278          ! applies to output which does not involve global communications) 
    279          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    280            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    281            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    282       ELSE 
    283          ! turn off all options. 
    284          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    285       ENDIF 
     277      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     278         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    286279      ! 
    287280      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    333326      ! 
    334327      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    335          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     328         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    336329      ELSE                              ! user-defined namelist 
    337          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     330         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    338331      ENDIF 
    339332      ! 
    … …  
    345338      CALL mpp_init 
    346339 
     340      CALL halo_mng_init() 
    347341      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    348342      CALL nemo_alloc() 
    … …  
    350344      ! Initialise time level indices 
    351345      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
     346#if defined key_agrif 
     347      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     348#endif  
    352349 
    353350      !                             !-------------------------------! 
    … …  
    358355      ! 
    359356      !                                      ! General initialization 
    360       IF( ln_timing    )   CALL timing_init     ! timing 
     357      IF( ln_timing    )   CALL timing_init ( 'timing_sas.output' ) 
    361358      IF( ln_timing    )   CALL timing_start( 'nemo_init') 
    362359 
    363360                           CALL phy_cst         ! Physical constants 
    364361                           CALL eos_init        ! Equation of seawater 
     362#if defined key_agrif 
     363     CALL Agrif_Declare_Var_ini   !  "      "   "   "      "  DOM 
     364#endif 
    365365                           CALL dom_init( Nbb, Nnn, Naa, 'SAS') ! Domain 
    366366      IF( sn_cfctl%l_prtctl )   & 
    … …  
    401401         WRITE(numout,*) '~~~~~~~~' 
    402402         WRITE(numout,*) '   Namelist namctl' 
    403          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    404          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    405          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    406403         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    407404         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    415412         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    416413         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    417          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    418          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    419          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    420          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    421          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    422          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    423          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    424414         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    425415         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    426416      ENDIF 
    427417      ! 
    428       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    429       nictls    = nn_ictls 
    430       nictle    = nn_ictle 
    431       njctls    = nn_jctls 
    432       njctle    = nn_jctle 
    433       isplt     = nn_isplt 
    434       jsplt     = nn_jsplt 
    435  
     418      IF( .NOT.ln_read_cfg )   ln_closea = .FALSE.   ! dealing possible only with a domcfg file 
    436419      IF(lwp) THEN                  ! control print 
    437420         WRITE(numout,*) 
    … …  
    444427         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    445428      ENDIF 
    446       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    447       ! 
    448       !                             ! Parameter control 
    449       ! 
    450       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    451          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    452             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    453          ELSE 
    454             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    455                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    456                   &           ' - the print control will be done over the whole domain' ) 
    457             ENDIF 
    458             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    459          ENDIF 
    460          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    461          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    462          ! 
    463          !                              ! indices used for the SUM control 
    464          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    465             lsp_area = .FALSE. 
    466          ELSE                                             ! print control done over a specific  area 
    467             lsp_area = .TRUE. 
    468             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    469                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    470                nictls = 1 
    471             ENDIF 
    472             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    473                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    474                nictle = jpiglo 
    475             ENDIF 
    476             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    477                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    478                njctls = 1 
    479             ENDIF 
    480             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    481                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    482                njctle = jpjglo 
    483             ENDIF 
    484          ENDIF 
    485       ENDIF 
    486429      ! 
    487430      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 
    … …  
    537480      ierr =        dia_wri_alloc() 
    538481      ierr = ierr + dom_oce_alloc()          ! ocean domain 
    539       ierr = ierr + oce_alloc    ()          ! (tsn...) needed for agrif and/or SI3 and bdy 
     482      ierr = ierr + oce_alloc    ()          ! (ts...) needed for agrif and/or SI3 and bdy 
    540483      ierr = ierr + bdy_oce_alloc()          ! bdy masks (incl. initialization) 
    541484      ! 
    … …  
    545488   END SUBROUTINE nemo_alloc 
    546489 
    547    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     490   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    548491      !!---------------------------------------------------------------------- 
    549492      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    550493      !! 
    551494      !! ** Purpose :   Set elements of the output control structure to setto. 
    552       !!                for_all should be .false. unless all areas are to be 
    553       !!                treated identically. 
    554495      !! 
    555496      !! ** Method  :   Note this routine can be used to switch on/off some 
    556       !!                types of output for selected areas but any output types 
    557       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    558       !!                should be protected from selective switching by the 
    559       !!                for_all argument 
    560       !!---------------------------------------------------------------------- 
    561       LOGICAL :: setto, for_all 
    562       TYPE(sn_ctl) :: sn_cfctl 
    563       !!---------------------------------------------------------------------- 
    564       IF( for_all ) THEN 
    565          sn_cfctl%l_runstat = setto 
    566          sn_cfctl%l_trcstat = setto 
    567       ENDIF 
     497      !!                types of output for selected areas. 
     498      !!---------------------------------------------------------------------- 
     499      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     500      LOGICAL     , INTENT(in   ) :: setto 
     501      !!---------------------------------------------------------------------- 
     502      sn_cfctl%l_runstat = setto 
     503      sn_cfctl%l_trcstat = setto 
    568504      sn_cfctl%l_oceout  = setto 
    569505      sn_cfctl%l_layout  = setto 
Note: See TracChangeset for help on using the changeset viewer.