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 12377 for NEMO/trunk/src/SAS – NEMO

Changeset 12377 for NEMO/trunk/src/SAS


Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
1 deleted
6 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • 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_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/trunk/src/SAS/diawri.F90

    r11536 r12377  
    2424   !!---------------------------------------------------------------------- 
    2525   USE oce             ! ocean dynamics and tracers  
     26   USE abl            ! abl variables in case ln_abl = .true. 
    2627   USE dom_oce         ! ocean space and time domain 
    2728   USE zdf_oce         ! ocean vertical physics 
     
    5152   PUBLIC   dia_wri_state 
    5253   PUBLIC   dia_wri_alloc           ! Called by nemogcm module 
    53  
     54#if ! defined key_iomput    
     55   PUBLIC   dia_wri_alloc_abl       ! Called by sbcabl  module (if ln_abl = .true.) 
     56#endif 
    5457   INTEGER ::   nid_T, nz_T, nh_T, ndim_T, ndim_hT   ! grid_T file 
    5558   INTEGER ::   nid_U, nz_U, nh_U, ndim_U, ndim_hU   ! grid_U file 
    5659   INTEGER ::   nid_V, nz_V, nh_V, ndim_V, ndim_hV   ! grid_V file 
     60   INTEGER ::   ndim_A, ndim_hA                      ! ABL file    
     61   INTEGER ::   nid_A, nz_A, nh_A                    ! grid_ABL file    
    5762   INTEGER ::   ndex(1)                              ! ??? 
    5863   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 
    59  
    60    !! * Substitutions 
    61 #  include "vectopt_loop_substitute.h90" 
     64   INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hA, ndex_A ! ABL 
     65 
    6266   !!---------------------------------------------------------------------- 
    6367   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    7882 
    7983    
    80    SUBROUTINE dia_wri( kt ) 
     84   SUBROUTINE dia_wri( kt, Kmm ) 
    8185      !!--------------------------------------------------------------------- 
    8286      !!                  ***  ROUTINE dia_wri  *** 
     
    9094      !! 
    9195      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     96      INTEGER, INTENT( in ) ::   Kmm     ! ocean time levelindex 
    9297      !!---------------------------------------------------------------------- 
    9398      !  
    9499      ! Output the initial state and forcings 
    95100      IF( ninist == 1 ) THEN 
    96          CALL dia_wri_state( 'output.init' ) 
     101         CALL dia_wri_state( 'output.init', Kmm ) 
    97102         ninist = 0 
    98103      ENDIF 
     
    114119   END FUNCTION dia_wri_alloc 
    115120    
     121   INTEGER FUNCTION dia_wri_alloc_abl() 
     122      !!---------------------------------------------------------------------- 
     123     ALLOCATE(   ndex_hA(jpi*jpj), ndex_A (jpi*jpj*jpkam1), STAT=dia_wri_alloc_abl) 
     124      CALL mpp_sum( 'diawri', dia_wri_alloc_abl ) 
     125      ! 
     126   END FUNCTION dia_wri_alloc_abl 
    116127   
    117128   SUBROUTINE dia_wri( kt ) 
     
    136147      INTEGER  ::   ierr                                     ! error code return from allocation 
    137148      INTEGER  ::   iimi, iima, ipk, it, itmod, ijmi, ijma   ! local integers 
     149      INTEGER  ::   ipka                                     ! ABL 
    138150      REAL(wp) ::   zsto, zout, zmax, zjulian                ! local scalars 
     151      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl   ! ABL 3D workspace 
    139152      !!---------------------------------------------------------------------- 
    140153      ! 
     
    174187      ijmi = 1      ;      ijma = jpj 
    175188      ipk = jpk 
     189     IF(ln_abl) ipka = jpkam1 
    176190 
    177191      ! define time axis 
     
    241255 
    242256         ! No W grid FILE 
     257         IF( ln_abl ) THEN  
     258         ! Define the ABL grid FILE ( nid_A ) 
     259            CALL dia_nam( clhstnam, nwrite, 'grid_ABL' ) 
     260            IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam    ! filename 
     261            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
     262               &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
     263               &          nit000-1, zjulian, rdt, nh_A, nid_A, domain_id=nidom, snc4chunks=snc4set ) 
     264            CALL histvert( nid_A, "ght_abl", "Vertical T levels",      &  ! Vertical grid: gdept 
     265               &           "m", ipka, ght_abl(2:jpka), nz_A, "up" ) 
     266            !                                                            ! Index of ocean points 
     267         ALLOCATE( zw3d_abl(jpi,jpj,ipka) )  
     268         zw3d_abl(:,:,:) = 1._wp  
     269         CALL wheneq( jpi*jpj*ipka, zw3d_abl, 1, 1., ndex_A , ndim_A  )      ! volume 
     270            CALL wheneq( jpi*jpj     , zw3d_abl, 1, 1., ndex_hA, ndim_hA )      ! surface 
     271         DEALLOCATE(zw3d_abl) 
     272         ENDIF 
    243273 
    244274         ! Declare all the output fields as NETCDF variables 
     
    261291         CALL histdef( nid_T, "sowindsp", "wind speed at 10m"                  , "m/s"    ,   &  ! wndm 
    262292            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
     293! 
     294         IF( ln_abl ) THEN 
     295         !                                                                                      !!! nid_A : 3D 
     296         CALL histdef( nid_A, "t_abl", "Potential Temperature"     , "K"        ,       &  ! t_abl 
     297               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     298            CALL histdef( nid_A, "q_abl", "Humidity"                  , "kg/kg"    ,       &  ! q_abl 
     299               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     300            CALL histdef( nid_A, "u_abl", "Atmospheric U-wind   "     , "m/s"        ,     &  ! u_abl 
     301               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout ) 
     302            CALL histdef( nid_A, "v_abl", "Atmospheric V-wind   "     , "m/s"    ,         &  ! v_abl 
     303               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     304            CALL histdef( nid_A, "tke_abl", "Atmospheric TKE   "     , "m2/s2"    ,        &  ! tke_abl 
     305               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     306            CALL histdef( nid_A, "avm_abl", "Atmospheric turbulent viscosity", "m2/s"   ,  &  ! avm_abl 
     307               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     308            CALL histdef( nid_A, "avt_abl", "Atmospheric turbulent diffusivity", "m2/s2",  &  ! avt_abl 
     309               &          jpi, jpj, nh_A, ipka, 1, ipka, nz_A, 32, clop, zsto, zout )  
     310            CALL histdef( nid_A, "pblh", "Atmospheric boundary layer height "  , "m",      &  ! pblh 
     311               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout )                  
     312#if defined key_si3 
     313            CALL histdef( nid_A, "oce_frac", "Fraction of open ocean"  , " ",      &  ! ato_i 
     314               &          jpi, jpj, nh_A,  1  , 1, 1   , -99 , 32, clop, zsto, zout ) 
     315#endif 
     316          CALL histend( nid_A, snc4chunks=snc4set ) 
     317       ! 
     318       ENDIF 
     319! 
    263320 
    264321         CALL histend( nid_T, snc4chunks=snc4set ) 
     
    310367      CALL histwrite( nid_T, "soicecov", it, fr_i          , ndim_hT, ndex_hT )   ! ice fraction    
    311368      CALL histwrite( nid_T, "sowindsp", it, wndm          , ndim_hT, ndex_hT )   ! wind speed    
     369! 
     370      IF( ln_abl ) THEN  
     371        ALLOCATE( zw3d_abl(jpi,jpj,jpka) ) 
     372        IF( ln_mskland )   THEN  
     373          DO jk=1,jpka 
     374             zw3d_abl(:,:,jk) = tmask(:,:,1) 
     375            END DO 
     376       ELSE 
     377            zw3d_abl(:,:,:) = 1._wp      
     378         ENDIF        
     379       CALL histwrite( nid_A,  "pblh"   , it, pblh(:,:)                  *zw3d_abl(:,:,1     ), ndim_hA, ndex_hA )   ! pblh  
     380        CALL histwrite( nid_A,  "u_abl"  , it, u_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! u_abl 
     381        CALL histwrite( nid_A,  "v_abl"  , it, v_abl   (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! v_abl 
     382        CALL histwrite( nid_A,  "t_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,1)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! t_abl 
     383        CALL histwrite( nid_A,  "q_abl"  , it, tq_abl  (:,:,2:jpka,nt_n,2)*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! q_abl      
     384        CALL histwrite( nid_A,  "tke_abl", it, tke_abl (:,:,2:jpka,nt_n  )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! tke_abl 
     385        CALL histwrite( nid_A,  "avm_abl", it, avm_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avm_abl 
     386        CALL histwrite( nid_A,  "avt_abl", it, avt_abl (:,:,2:jpka       )*zw3d_abl(:,:,2:jpka), ndim_A , ndex_A  )   ! avt_abl   
     387#if defined key_si3 
     388         CALL histwrite( nid_A,  "oce_frac"   , it, ato_i(:,:)                                  , ndim_hA, ndex_hA )   ! ato_i 
     389#endif 
     390       DEALLOCATE(zw3d_abl) 
     391     ENDIF 
     392! 
    312393 
    313394         ! Write fields on U grid 
     
    325406         CALL histclo( nid_U ) 
    326407         CALL histclo( nid_V ) 
     408         IF(ln_abl) CALL histclo( nid_A ) 
    327409      ENDIF 
    328410      ! 
     
    332414#endif 
    333415 
    334    SUBROUTINE dia_wri_state( cdfile_name ) 
     416   SUBROUTINE dia_wri_state( cdfile_name, Kmm ) 
    335417      !!--------------------------------------------------------------------- 
    336418      !!                 ***  ROUTINE dia_wri_state  *** 
     
    346428      !!---------------------------------------------------------------------- 
    347429      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
     430      INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    348431      !! 
    349432      INTEGER :: inum 
     
    361444#endif 
    362445 
    363       CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
    364       CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
    365       CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
    366       CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
    367       CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
    368       CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
    369       CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
    370       CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
    371       CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
    372       CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
    373       CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
    374       CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
     446      CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) )    ! now temperature 
     447      CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) )    ! now salinity 
     448      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,         Kmm) )    ! sea surface height 
     449      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu (:,:,:,       Kmm) )    ! now i-velocity 
     450      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv (:,:,:,       Kmm) )    ! now j-velocity 
     451      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww                    )    ! now k-velocity 
     452      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf             )    ! freshwater budget 
     453      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns             )    ! total heat flux 
     454      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr                   )    ! solar heat flux 
     455      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i                  )    ! ice fraction 
     456      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau                  )    ! i-wind stress 
     457      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau                  )    ! j-wind stress 
    375458  
    376459#if defined key_si3 
  • NEMO/trunk/src/SAS/nemogcm.F90

    r11536 r12377  
    3232   USE bdyini         ! open boundary cond. setting       (bdy_init routine). mandatory for sea-ice 
    3333   USE bdydta         ! open boundary cond. setting   (bdy_dta_init routine). mandatory for sea-ice 
     34   USE diu_layers     ! diurnal bulk SST and coolskin 
     35   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    3436   ! 
    3537   USE lib_mpp        ! distributed memory computing 
     
    5254   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    5355 
     56#if defined key_mpp_mpi 
     57   INCLUDE 'mpif.h' 
     58#endif 
     59 
    5460   !!---------------------------------------------------------------------- 
    5561   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
     
    8389      !                            !-----------------------! 
    8490#if defined key_agrif 
     91      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    8592      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    8693      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     
    109116#if defined key_si3 
    110117      ! Recursive update from highest nested level to lowest: 
     118      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    111119      CALL Agrif_step_child_adj(Agrif_update_ice) 
    112120#endif 
     
    128136         ! 
    129137         DO WHILE( istp <= nitend .AND. nstop == 0 ) 
     138#if defined key_mpp_mpi 
     139            ncom_stp = istp 
     140            IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime() 
     141            IF ( istp ==         nitend ) elapsed_time = MPI_Wtime() - elapsed_time 
     142#endif 
    130143            CALL stp        ( istp )  
    131144            istp = istp + 1 
     
    185198      INTEGER ::   ios, ilocal_comm   ! local integers 
    186199      !! 
    187       NAMELIST/namctl/ ln_ctl   , sn_cfctl, nn_print, nn_ictls, nn_ictle,   & 
     200      NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              & 
    188201         &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    189202         &             ln_timing, ln_diacfl 
     
    230243      ! open ocean.output as soon as possible to get all output prints (including errors messages) 
    231244      IF( lk_oasis ) THEN 
    232          IF( lwm )   CALL ctl_opn(     numout,              'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     245         IF( lwm )   CALL ctl_opn(     numout,               'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    233246         ! open reference and configuration namelist files 
    234                      CALL ctl_opn( numnam_ref,        'namelist_sas_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    235                      CALL ctl_opn( numnam_cfg,        'namelist_sas_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    236          IF( lwm )   CALL ctl_opn(     numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     247                     CALL load_nml( numnam_ref,        'namelist_sas_ref',                                           -1, lwm ) 
     248                     CALL load_nml( numnam_cfg,        'namelist_sas_cfg',                                           -1, lwm ) 
     249         IF( lwm )   CALL ctl_opn(      numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    237250      ELSE 
    238          IF( lwm )   CALL ctl_opn(     numout,            'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     251         IF( lwm )   CALL ctl_opn(      numout,            'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    239252         ! open reference and configuration namelist files 
    240                      CALL ctl_opn( numnam_ref,            'namelist_ref',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    241                      CALL ctl_opn( numnam_cfg,            'namelist_cfg',     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    242          IF( lwm )   CALL ctl_opn(     numond,     'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
     253                     CALL load_nml( numnam_ref,            'namelist_ref',                                           -1, lwm ) 
     254                     CALL load_nml( numnam_cfg,            'namelist_cfg',                                           -1, lwm ) 
     255         IF( lwm )   CALL ctl_opn(      numond,     'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 
    243256      ENDIF 
    244257      ! open /dev/null file to be able to supress output write easily 
     
    246259      ! 
    247260      !                             !--------------------! 
    248       !                             ! Open listing units !  -> need ln_ctl from namctl to define lwp 
     261      !                             ! Open listing units !  -> need sn_cfctl from namctl to define lwp 
    249262      !                             !--------------------! 
    250263      ! 
    251       REWIND( numnam_ref )              ! Namelist namctl in reference namelist 
    252264      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 
    253265901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namctl in reference namelist' ) 
    254       REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist 
    255266      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 
    256267902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 
    257268      ! 
    258       lwp = (narea == 1) .OR. ln_ctl    ! control of all listing output print 
     269      ! 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 
     286      ! 
     287      lwp = (narea == 1) .OR. sn_cfctl%l_oceout    ! control of all listing output print 
    259288      ! 
    260289      IF(lwp) THEN                      ! open listing units 
     
    291320         ! 
    292321      ENDIF 
    293      ! 
    294       ! finalize the definition of namctl variables 
    295       IF( sn_cfctl%l_config ) THEN 
    296          ! Activate finer control of report outputs 
    297          ! optionally switch off output from selected areas (note this only 
    298          ! applies to output which does not involve global communications) 
    299          IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax  ) .OR. & 
    300            & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) )    & 
    301            &   CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 
    302       ELSE 
    303          ! Use ln_ctl to turn on or off all options. 
    304          CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 
    305       ENDIF 
    306322      ! 
    307323      IF(lwm) WRITE( numond, namctl ) 
     
    311327      !                             !------------------------------------! 
    312328      ! 
    313       REWIND( numnam_ref )              ! Namelist namcfg in reference namelist 
    314329      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 
    315330903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 
    316       REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist 
    317331      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 
    318332904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namcfg in configuration namelist' )    
     
    334348      CALL nemo_alloc() 
    335349 
     350      ! Initialise time level indices 
     351      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
     352 
    336353      !                             !-------------------------------! 
    337354      !                             !  NEMO general initialization  ! 
     
    346363                           CALL phy_cst         ! Physical constants 
    347364                           CALL eos_init        ! Equation of seawater 
    348                            CALL dom_init('SAS') ! Domain 
    349       IF( ln_ctl      )    CALL prt_ctl_init    ! Print control 
     365                           CALL dom_init( Nbb, Nnn, Naa, 'SAS') ! Domain 
     366      IF( sn_cfctl%l_prtctl )   & 
     367         &                 CALL prt_ctl_init        ! Print control 
    350368       
    351369                           CALL day_init        ! model calendar (using both namelist and restart infos) 
     
    353371 
    354372      !                                      ! external forcing  
    355                            CALL sbc_init        ! Forcings : surface module  
     373                           CALL sbc_init( Nbb, Nnn, Naa )  ! Forcings : surface module  
    356374 
    357375      ! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from   
     
    375393      !! ** Purpose :   control print setting 
    376394      !! 
    377       !! ** Method  : - print namctl information and check some consistencies 
     395      !! ** Method  : - print namctl and namcfg information and check some consistencies 
    378396      !!---------------------------------------------------------------------- 
    379397      ! 
     
    383401         WRITE(numout,*) '~~~~~~~~' 
    384402         WRITE(numout,*) '   Namelist namctl' 
    385          WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl 
     403         WRITE(numout,*) '                              sn_cfctl%l_glochk  = ', sn_cfctl%l_glochk 
     404         WRITE(numout,*) '                              sn_cfctl%l_allon   = ', sn_cfctl%l_allon 
    386405         WRITE(numout,*) '       finer control over o/p sn_cfctl%l_config  = ', sn_cfctl%l_config 
    387406         WRITE(numout,*) '                              sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 
     
    389408         WRITE(numout,*) '                              sn_cfctl%l_oceout  = ', sn_cfctl%l_oceout 
    390409         WRITE(numout,*) '                              sn_cfctl%l_layout  = ', sn_cfctl%l_layout 
    391          WRITE(numout,*) '                              sn_cfctl%l_mppout  = ', sn_cfctl%l_mppout 
    392          WRITE(numout,*) '                              sn_cfctl%l_mpptop  = ', sn_cfctl%l_mpptop 
     410         WRITE(numout,*) '                              sn_cfctl%l_prtctl  = ', sn_cfctl%l_prtctl 
     411         WRITE(numout,*) '                              sn_cfctl%l_prttrc  = ', sn_cfctl%l_prttrc 
     412         WRITE(numout,*) '                              sn_cfctl%l_oasout  = ', sn_cfctl%l_oasout 
    393413         WRITE(numout,*) '                              sn_cfctl%procmin   = ', sn_cfctl%procmin   
    394414         WRITE(numout,*) '                              sn_cfctl%procmax   = ', sn_cfctl%procmax   
     
    428448      !                             ! Parameter control 
    429449      ! 
    430       IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints 
     450      IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    431451         IF( lk_mpp .AND. jpnij > 1 ) THEN 
    432452            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
     
    489509      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file       
    490510      IF( numrun          /= -1 )   CLOSE( numrun          )   ! run statistics file 
    491       IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist 
    492       IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist 
    493511      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist 
    494       IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist 
    495       IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist 
    496512      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist 
    497513      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution) 
     
    552568      sn_cfctl%l_oceout  = setto 
    553569      sn_cfctl%l_layout  = setto 
    554       sn_cfctl%l_mppout  = setto 
    555       sn_cfctl%l_mpptop  = setto 
     570      sn_cfctl%l_prtctl  = setto 
     571      sn_cfctl%l_prttrc  = setto 
     572      sn_cfctl%l_oasout  = setto 
    556573   END SUBROUTINE nemo_set_cfctl 
    557574 
  • NEMO/trunk/src/SAS/sbcssm.F90

    r11536 r12377  
    6262CONTAINS 
    6363 
    64    SUBROUTINE sbc_ssm( kt ) 
     64   SUBROUTINE sbc_ssm( kt, Kbb, Kmm ) 
    6565      !!---------------------------------------------------------------------- 
    6666      !!                  ***  ROUTINE sbc_ssm  *** 
     
    7373      !!---------------------------------------------------------------------- 
    7474      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
     76                          ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    7577      ! 
    7678      INTEGER  ::   ji, jj     ! dummy loop indices 
     
    119121         IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 
    120122         frq_m(:,:) = 1._wp                              !              - - 
    121          sshn (:,:) = 0._wp                              !              - - 
     123         ssh  (:,:,Kmm) = 0._wp                              !              - - 
    122124      ENDIF 
    123125       
    124126      IF ( nn_ice == 1 ) THEN 
    125          tsn(:,:,1,jp_tem) = sst_m(:,:) 
    126          tsn(:,:,1,jp_sal) = sss_m(:,:) 
    127          tsb(:,:,1,jp_tem) = sst_m(:,:) 
    128          tsb(:,:,1,jp_sal) = sss_m(:,:) 
    129       ENDIF 
    130       ub (:,:,1) = ssu_m(:,:) 
    131       vb (:,:,1) = ssv_m(:,:) 
     127         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 
     128         ts(:,:,1,jp_sal,Kmm) = sss_m(:,:) 
     129         ts(:,:,1,jp_tem,Kbb) = sst_m(:,:) 
     130         ts(:,:,1,jp_sal,Kbb) = sss_m(:,:) 
     131      ENDIF 
     132      uu (:,:,1,Kbb) = ssu_m(:,:) 
     133      vv (:,:,1,Kbb) = ssv_m(:,:) 
    132134  
    133       IF(ln_ctl) THEN                  ! print control 
     135      IF(sn_cfctl%l_prtctl) THEN            ! print control 
    134136         CALL prt_ctl(tab2d_1=sst_m, clinfo1=' sst_m   - : ', mask1=tmask   ) 
    135137         CALL prt_ctl(tab2d_1=sss_m, clinfo1=' sss_m   - : ', mask1=tmask   ) 
     
    156158 
    157159 
    158    SUBROUTINE sbc_ssm_init 
     160   SUBROUTINE sbc_ssm_init( Kbb, Kmm ) 
    159161      !!---------------------------------------------------------------------- 
    160162      !!                  ***  ROUTINE sbc_ssm_init  *** 
     
    162164      !! ** Purpose :   Initialisation of sea surface mean data      
    163165      !!---------------------------------------------------------------------- 
     166      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices  
     167                          ! (not needed for SAS but needed to keep a consistent interface in sbcmod.F90) 
    164168      INTEGER  :: ierr, ierr0, ierr1, ierr2, ierr3   ! return error code 
    165169      INTEGER  :: ifpr                               ! dummy loop indice 
     
    186190      ENDIF 
    187191      ! 
    188       REWIND( numnam_ref )              ! Namelist namsbc_sas in reference namelist : Input fields 
    189192      READ  ( numnam_ref, namsbc_sas, IOSTAT = ios, ERR = 901) 
    190193901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_sas in reference namelist' ) 
    191       REWIND( numnam_cfg )              ! Namelist namsbc_sas in configuration namelist : Input fields 
    192194      READ  ( numnam_cfg, namsbc_sas, IOSTAT = ios, ERR = 902 ) 
    193195902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_sas in configuration namelist' ) 
     
    311313      ENDIF 
    312314      ! 
    313       CALL sbc_ssm( nit000 )   ! need to define ss?_m arrays used in iceistate 
     315      CALL sbc_ssm( nit000, Kbb, Kmm )   ! need to define ss?_m arrays used in iceistate 
    314316      l_initdone = .TRUE. 
    315317      ! 
  • NEMO/trunk/src/SAS/step.F90

    r11536 r12377  
    4949 
    5050   !!---------------------------------------------------------------------- 
     51   !! time level indices 
     52   !!---------------------------------------------------------------------- 
     53   INTEGER, PUBLIC :: Nbb, Nnn, Naa, Nrhs          !! used by nemo_init 
     54   !!---------------------------------------------------------------------- 
    5155   !! NEMO/SAS 4.0 , NEMO Consortium (2018) 
    5256   !! $Id$ 
     
    7579#if defined key_agrif 
    7680      kstp = nit000 + Agrif_Nb_Step() 
     81      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    7782      IF ( lk_agrif_debug ) THEN 
    7883         IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
     
    96101      !           From SAS: ocean bdy data are wrong  (but we do not care) and ice bdy data are OK.   
    97102      !           This is not clean and should be changed in the future.  
    98       IF( ln_bdy     )       CALL bdy_dta ( kstp, kt_offset=+1 )   ! update dynamic & tracer data at open boundaries 
    99103      ! ==> 
    100                              CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
     104      IF( ln_bdy     )       CALL bdy_dta( kstp,      Nnn )                   ! update dynamic & tracer data at open boundaries 
     105                             CALL sbc    ( kstp, Nbb, Nnn )                   ! Sea Boundary Condition (including sea-ice) 
    101106 
    102                              CALL dia_wri( kstp )         ! ocean model: outputs 
     107                             CALL dia_wri( kstp,      Nnn )                   ! ocean model: outputs 
    103108 
    104109#if defined key_agrif 
     
    121126      IF( indic < 0  )  THEN 
    122127                             CALL ctl_stop( 'step: indic < 0' ) 
    123                              CALL dia_wri_state( 'output.abort' ) 
     128                             CALL dia_wri_state( 'output.abort', Nnn ) 
    124129      ENDIF 
    125       IF( kstp == nit000   ) CALL iom_close( numror )     ! close input  ocean restart file 
     130      IF( kstp == nit000   ) CALL iom_close( numror )           ! close input  ocean restart file 
    126131       
    127132      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    128133      ! Coupled mode 
    129134      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    130       IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice 
     135      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice 
    131136 
    132137#if defined key_iomput 
  • NEMO/trunk/src/SAS/stpctl.F90

    r10603 r12377  
    6363      ! 
    6464      ll_wrtstp  = ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 
    65       ll_colruns = ll_wrtstp .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) 
     65      ll_colruns = ll_wrtstp .AND. ( sn_cfctl%l_runstat ) 
    6666      ll_wrtruns = ll_colruns .AND. lwm 
    6767      IF( kt == nit000 .AND. lwp ) THEN 
     
    7373         !                                ! open run.stat file(s) at start whatever 
    7474         !                                ! the value of sn_cfctl%ptimincr 
    75          IF( lwm .AND. ( ln_ctl .OR. sn_cfctl%l_runstat ) ) THEN 
     75         IF( lwm .AND. ( sn_cfctl%l_runstat ) ) THEN 
    7676            CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    7777            clname = 'run.stat.nc' 
Note: See TracChangeset for help on using the changeset viewer.