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/tests/STATION_ASF/MY_SRC/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/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r12254 r13540  
    22   !!====================================================================== 
    33   !!                       ***  MODULE nemogcm   *** 
    4    !! StandAlone Surface module : surface fluxes 
     4   !!                      STATION_ASF (SAS meets C1D) 
    55   !!====================================================================== 
    66   !! History :  3.6  ! 2011-11  (S. Alderson, G. Madec) original code 
    … …  
    1919   !!---------------------------------------------------------------------- 
    2020   USE step_oce       ! module used in the ocean time stepping module (step.F90) 
    21    USE sbc_oce        ! surface boundary condition: ocean #LB: rm? 
    2221   USE phycst         ! physical constant                  (par_cst routine) 
    2322   USE domain         ! domain initialization   (dom_init & dom_cfg routines) 
    2423   USE closea         ! treatment of closed seas (for ln_closea) 
    2524   USE usrdef_nam     ! user defined configuration 
     25   USE istate         ! initial state setting          (istate_init routine) 
    2626   USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices 
    2727   USE daymod         ! calendar 
    2828   USE restart        ! open  restart file 
    29    !LB:USE step           ! NEMO time-stepping                 (stp     routine) 
    3029   USE c1d            ! 1D configuration 
    3130   USE step_c1d       ! Time stepping loop for the 1D configuration 
    32    USE sbcssm         ! 
    3331   ! 
     32   USE prtctl         ! Print control 
     33   USE in_out_manager ! I/O manager 
    3434   USE lib_mpp        ! distributed memory computing 
    3535   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    … …  
    4949   !!---------------------------------------------------------------------- 
    5050   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    51    !! $Id: nemogcm.F90 11536 2019-09-11 13:54:18Z smasson $ 
     51   !! $Id: nemogcm.F90 12489 2020-02-28 15:55:11Z davestorkey $ 
    5252   !! Software governed by the CeCILL license (see ./LICENSE) 
    5353   !!---------------------------------------------------------------------- 
    … …  
    8484      !                            !==   time stepping   ==! 
    8585      !                            !-----------------------! 
     86      ! 
     87      !                                               !== set the model time-step  ==! 
     88      ! 
    8689      istp = nit000 
    8790      ! 
    … …  
    98101      IF( nstop /= 0 .AND. lwp ) THEN        ! error print 
    99102         WRITE(ctmp1,*) '   ==>>>   nemo_gcm: a total of ', nstop, ' errors have been found' 
    100          CALL ctl_stop( ctmp1 ) 
     103         WRITE(ctmp2,*) '           Look for "E R R O R" messages in all existing ocean_output* files' 
     104         CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 
    101105      ENDIF 
    102106      ! 
    … …  
    106110      ! 
    107111#if defined key_iomput 
    108       CALL xios_finalize  ! end mpp communications with xios 
     112                                    CALL xios_finalize  ! end mpp communications with xios 
    109113#else 
    110       IF( lk_mpp   ) THEN   ;   CALL mppstop      ! end mpp communications 
    111       ENDIF 
     114      IF( lk_mpp )                  CALL mppstop      ! end mpp communications 
    112115#endif 
    113116      ! 
    … …  
    129132      INTEGER ::   ios, ilocal_comm   ! local integers 
    130133      !! 
    131       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    132          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    133          &             ln_timing, ln_diacfl 
     134      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     135         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle 
    134136      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    135137      !!---------------------------------------------------------------------- 
    … …  
    161163      IF( lwm )   CALL ctl_opn(     numout,        'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    162164      ! open reference and configuration namelist files 
    163       CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm ) 
    164       CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm ) 
     165                  CALL load_nml( numnam_ref,        'namelist_ref',                                           -1, lwm ) 
     166                  CALL load_nml( numnam_cfg,        'namelist_cfg',                                           -1, lwm ) 
    165167      IF( lwm )   CALL ctl_opn(     numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    166168      ! open /dev/null file to be able to supress output write easily 
    167       CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     169      IF( Agrif_Root() ) THEN 
     170                  CALL ctl_opn(     numnul,           '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     171#ifdef key_agrif 
     172      ELSE 
     173                  numnul = Agrif_Parent(numnul)    
     174#endif 
     175      ENDIF 
    168176      ! 
    169177      !                             !--------------------! 
    … …  
    177185      ! 
    178186      ! finalize the definition of namctl variables 
    179       IF( sn_cfctl%l_allon ) THEN 
    180          ! Turn on all options. 
    181          CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. ) 
    182          ! Ensure all processors are active 
    183          sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1 
    184       ELSEIF( sn_cfctl%l_config ) THEN 
    185          ! Activate finer control of report outputs 
    186          ! optionally switch off output from selected areas (note this only 
    187          ! applies to output which does not involve global communications) 
    188          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    189            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    190            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    191       ELSE 
    192          ! turn off all options. 
    193          CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. ) 
    194       ENDIF 
     187      IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 )   & 
     188         &   CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 
    195189      ! 
    196190      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    … …  
    235229903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
    236230      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    237 904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 
     231904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
    238232      ! 
    239233      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    240          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     234         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    241235      ELSE                              ! user-defined namelist 
    242          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     236         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    243237      ENDIF 
    244238      ! 
    … …  
    266260      IF( ln_timing    )   CALL timing_start( 'nemo_init') 
    267261      ! 
    268       CALL     phy_cst         ! Physical constants 
    269       CALL     eos_init        ! Equation of state 
     262                           CALL     phy_cst         ! Physical constants 
     263                           CALL     eos_init        ! Equation of state 
    270264      IF( lk_c1d       )   CALL     c1d_init        ! 1D column configuration 
    271       CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
     265                           CALL     dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 
    272266      IF( sn_cfctl%l_prtctl )   & 
    273267         &                 CALL prt_ctl_init        ! Print control 
    274  
    275       IF( ln_rstart ) THEN                    ! Restart from a file                                                                                  
    276          !                                    ! -------------------                                                                                  
    277          CALL rst_read( Nbb, Nnn )            ! Read the restart file                                                                                
    278          CALL day_init                        ! model calendar (using both namelist and restart infos)                                               
    279          !                                                                                                                                           
    280       ELSE                                    ! Start from rest                                                                                      
    281          !                                    ! ---------------                                                                                      
    282          numror = 0                           ! define numror = 0 -> no restart file to read                                                         
    283          neuler = 0                           ! Set time-step indicator at nit000 (euler forward)                                                    
    284          CALL day_init                        ! model calendar (using both namelist and restart infos)                                               
    285       ENDIF 
    286       ! 
    287  
    288       !                                      ! external forcing 
    289       CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
     268      ! 
     269       
     270                           CALL  istate_init( Nbb, Nnn, Naa )    ! ocean initial state (Dynamics and tracers) 
     271 
     272      !                                      ! external forcing  
     273                           CALL     sbc_init( Nbb, Nnn, Naa )    ! surface boundary conditions (including sea-ice) 
    290274 
    291275      ! 
    … …  
    311295         WRITE(numout,*) '~~~~~~~~' 
    312296         WRITE(numout,*) '   Namelist namctl' 
    313          WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
    314          WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    315          WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    316297         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
    317298         WRITE(numout,*) '                              sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 
    … …  
    321302         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc 
    322303         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout 
    323          WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin 
    324          WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax 
    325          WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr 
    326          WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr 
    327          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    328          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    329          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    330          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    331          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    332          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    333          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
     304         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin   
     305         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax   
     306         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
     307         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    334308         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    335309         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    336310      ENDIF 
    337311      ! 
    338       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    339       nictls    = nn_ictls 
    340       nictle    = nn_ictle 
    341       njctls    = nn_jctls 
    342       njctle    = nn_jctle 
    343       isplt     = nn_isplt 
    344       jsplt     = nn_jsplt 
    345  
     312      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    346313      IF(lwp) THEN                  ! control print 
    347314         WRITE(numout,*) 
    … …  
    354321         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    355322      ENDIF 
    356       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    357       ! 
    358       !                             ! Parameter control 
    359       ! 
    360       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    361          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    362             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    363          ELSE 
    364             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    365                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    366                   &           ' - the print control will be done over the whole domain' ) 
    367             ENDIF 
    368             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    369          ENDIF 
    370          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    371          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    372          ! 
    373          !                              ! indices used for the SUM control 
    374          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    375             lsp_area = .FALSE. 
    376          ELSE                                             ! print control done over a specific  area 
    377             lsp_area = .TRUE. 
    378             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    379                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    380                nictls = 1 
    381             ENDIF 
    382             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    383                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    384                nictle = jpiglo 
    385             ENDIF 
    386             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    387                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    388                njctls = 1 
    389             ENDIF 
    390             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    391                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    392                njctle = jpjglo 
    393             ENDIF 
    394          ENDIF 
    395       ENDIF 
    396323      ! 
    397324      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 
    … …  
    439366      !!---------------------------------------------------------------------- 
    440367      ! 
    441       ierr =        oce_alloc    ()    ! ocean 
     368      ierr =        oce_alloc    ()    ! ocean  
    442369      ierr = ierr + dia_wri_alloc() 
    443370      ierr = ierr + dom_oce_alloc()    ! ocean domain 
    … …  
    448375   END SUBROUTINE nemo_alloc 
    449376 
    450  
    451    SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 
     377    
     378   SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 
    452379      !!---------------------------------------------------------------------- 
    453380      !!                     ***  ROUTINE nemo_set_cfctl  *** 
    454381      !! 
    455382      !! ** Purpose :   Set elements of the output control structure to setto. 
    456       !!                for_all should be .false. unless all areas are to be 
    457       !!                treated identically. 
    458383      !! 
    459384      !! ** Method  :   Note this routine can be used to switch on/off some 
    460       !!                types of output for selected areas but any output types 
    461       !!                that involve global communications (e.g. mpp_max, glob_sum) 
    462       !!                should be protected from selective switching by the 
    463       !!                for_all argument 
    464       !!---------------------------------------------------------------------- 
    465       LOGICAL :: setto, for_all 
    466       TYPE(sn_ctl) :: sn_cfctl 
    467       !!---------------------------------------------------------------------- 
    468       IF( for_all ) THEN 
    469          sn_cfctl%l_runstat = setto 
    470          sn_cfctl%l_trcstat = setto 
    471       ENDIF 
     385      !!                types of output for selected areas. 
     386      !!---------------------------------------------------------------------- 
     387      TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 
     388      LOGICAL     , INTENT(in   ) :: setto 
     389      !!---------------------------------------------------------------------- 
     390      sn_cfctl%l_runstat = setto 
     391      sn_cfctl%l_trcstat = setto 
    472392      sn_cfctl%l_oceout  = setto 
    473393      sn_cfctl%l_layout  = setto 
    … …  
    479399   !!====================================================================== 
    480400END MODULE nemogcm 
     401 
Note: See TracChangeset for help on using the changeset viewer.