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 13176 – NEMO

Changeset 13176


Ignore:
Timestamp:
2020-06-29T18:02:13+02:00 (4 years ago)
Author:
smasson
Message:

Extra_Halo: rewrite prtctl, supress nn_print, see #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo
Files:
1 deleted
57 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/cfgs/SHARED/namelist_ref

    r13065 r13176  
    14121412   sn_cfctl%procincr  = 1         ! Increment for optional subsetting of areas [default:1] 
    14131413   sn_cfctl%ptimincr  = 1         ! Timestep increment for writing time step progress info 
    1414    nn_print    =    0             !  level of print (0 no extra print) 
    14151414   nn_ictls    =    0             !  start i indice of control sum (use to compare mono versus 
    14161415   nn_ictle    =    0             !  end   i indice of control sum        multi processor runs 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ABL/ablmod.F90

    r12939 r13176  
    565565      IF(sn_cfctl%l_prtctl) THEN 
    566566         CALL prt_ctl( tab2d_1=pwndm  , clinfo1=' abl_stp: wndm   : ' ) 
    567          CALL prt_ctl( tab2d_1=ptaui  , clinfo1=' abl_stp: utau   : ' ) 
    568          CALL prt_ctl( tab2d_2=ptauj  , clinfo2=          'vtau   : ' ) 
     567         CALL prt_ctl( tab2d_1=ptaui  , clinfo1=' abl_stp: utau   : ',   & 
     568            &          tab2d_2=ptauj  , clinfo2=          'vtau   : ' ) 
    569569      ENDIF 
    570570 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ICE/icectl.F90

    r12939 r13176  
    702702      DO jl = 1, jpl 
    703703         CALL prt_ctl_info(' ') 
    704          CALL prt_ctl_info(' - Category : ', ivar1=jl) 
     704         CALL prt_ctl_info(' - Category : ', ivar=jl) 
    705705         CALL prt_ctl_info('   ~~~~~~~~~~') 
    706706         CALL prt_ctl(tab2d_1=h_i        (:,:,jl)        , clinfo1= ' h_i         : ') 
    … …  
    719719          
    720720         DO jk = 1, nlay_i 
    721             CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
     721            CALL prt_ctl_info(' - Layer : ', ivar=jk) 
    722722            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ') 
    723723         END DO 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/daymod.F90

    r12489 r13176  
    279279      IF(sn_cfctl%l_prtctl) THEN 
    280280         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    281          CALL prt_ctl_info(charout) 
     281         CALL prt_ctl_info( charout ) 
    282282      ENDIF 
    283283 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90

    r13065 r13176  
    254254         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk 
    255255         WRITE(numout,*) 
    256          WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done' 
    257          IF( nn_print >= 1 ) THEN 
    258             WRITE(numout,*) 
    259             WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)' 
    260             WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
    261             WRITE(numout,*) 
    262             WRITE(numout,*) '          conversion global ==> local  i-index domain' 
    263             WRITE(numout,*) '             starting index (mi0)' 
    264             WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo) 
    265             WRITE(numout,*) '             ending index (mi1)' 
    266             WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo) 
    267             WRITE(numout,*) 
    268             WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)' 
    269             WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
    270             WRITE(numout,*) 
    271             WRITE(numout,*) '          conversion global ==> local  j-index domain' 
    272             WRITE(numout,*) '             starting index (mj0)' 
    273             WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo) 
    274             WRITE(numout,*) '             ending index (mj1)' 
    275             WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo) 
    276          ENDIF 
    277       ENDIF 
    278  25   FORMAT( 100(10x,19i4,/) ) 
     256      ENDIF 
    279257      ! 
    280258   END SUBROUTINE dom_glo 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domzgr.F90

    r13138 r13176  
    182182!!gm end bug 
    183183      ! 
    184       IF( nprint == 1 .AND. lwp )   THEN 
     184      IF( lwp )   THEN 
    185185         WRITE(numout,*) ' MIN val k_top   ', MINVAL(   k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) ) 
    186186         WRITE(numout,*) ' MIN val k_bot   ', MINVAL(   k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) ) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/in_out_manager.F90

    r12939 r13176  
    118118   LOGICAL ::   ln_timing        !: run control for timing 
    119119   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics 
    120    INTEGER ::   nn_print         !: level of print (0 no print) 
    121120   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 
    122121   INTEGER ::   nn_ictle         !: End   i indice for the SUM control 
    … …  
    125124   INTEGER ::   nn_isplt         !: number of processors following i 
    126125   INTEGER ::   nn_jsplt         !: number of processors following j 
    127    !                                           
    128    INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names 
    129  
    130    INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors 
    131126 
    132127   !!---------------------------------------------------------------------- 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/prtctl.F90

    r12807 r13176  
    88   !!---------------------------------------------------------------------- 
    99   USE dom_oce          ! ocean space and time domain variables 
    10 #if defined key_nemocice_decomp 
    11    USE ice_domain_size, only: nx_global, ny_global 
    12 #endif 
    1310   USE in_out_manager   ! I/O manager 
     11   USE mppini           ! distributed memory computing 
    1412   USE lib_mpp          ! distributed memory computing 
    1513 
    1614   IMPLICIT NONE 
    1715   PRIVATE 
    18  
    19    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid 
    20    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nis0allp, njs0allp   ! first, last indoor index for each i-domain 
    21    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nie0allp, nje0allp   ! first, last indoor index for each j-domain 
    22    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::    nimpptl,  njmpptl   ! i-, j-indexes for each processor 
    23    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::    jpiallp,  jpjallp   ! dimensions of every subdomain 
    24    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::    ibonitl,  ibonjtl   ! 
    25  
    26    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values 
    27    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values 
    28  
    29    INTEGER ::   ktime   ! time step 
    30  
     16    
     17   INTEGER , DIMENSION(  :), ALLOCATABLE ::   numprt_oce, numprt_top 
     18   INTEGER , DIMENSION(  :), ALLOCATABLE ::   nall_ictls, nall_ictle   ! first, last indoor index for each i-domain 
     19   INTEGER , DIMENSION(  :), ALLOCATABLE ::   nall_jctls, nall_jctle   ! first, last indoor index for each j-domain 
     20   REAL(wp), DIMENSION(  :), ALLOCATABLE ::   t_ctl , s_ctl            ! previous tracer trend values 
     21   REAL(wp), DIMENSION(  :), ALLOCATABLE ::   u_ctl , v_ctl            ! previous velocity trend values 
     22   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   tra_ctl                  ! previous top trend values 
     23   !                                           
    3124   PUBLIC prt_ctl         ! called by all subroutines 
    3225   PUBLIC prt_ctl_info    ! called by all subroutines 
    33    PUBLIC prt_ctl_init    ! called by opa.F90 
    34    PUBLIC sub_dom         ! called by opa.F90 
     26   PUBLIC prt_ctl_init    ! called by nemogcm.F90 and prt_ctl_trc_init 
    3527 
    3628   !!---------------------------------------------------------------------- 
    … …  
    4133CONTAINS 
    4234 
    43    SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   & 
    44       &                                  mask2, clinfo2, kdim, clinfo3 ) 
     35   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2,   & 
     36      &                 clinfo, clinfo1, clinfo2, clinfo3, kdim ) 
    4537      !!---------------------------------------------------------------------- 
    4638      !!                     ***  ROUTINE prt_ctl  *** 
    … …  
    6860      !!                    tab2d_1 : first 2D array 
    6961      !!                    tab3d_1 : first 3D array 
     62      !!                    tab4d_1 : first 4D array 
    7063      !!                    mask1   : mask (3D) to apply to the tab[23]d_1 array 
    7164      !!                    clinfo1 : information about the tab[23]d_1 array 
    … …  
    7770      !!                    clinfo3 : additional information  
    7871      !!---------------------------------------------------------------------- 
    79       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1 
    80       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1 
    81       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1 
    82       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1 
    83       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2 
    84       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2 
    85       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2 
    86       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2 
    87       INTEGER                   , INTENT(in), OPTIONAL ::   kdim 
    88       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3 
    89       ! 
    90       CHARACTER (len=15) :: cl2 
    91       INTEGER ::  jn, sind, eind, kdir,j_id 
     72      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_1 
     73      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_1 
     74      REAL(wp),         DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d_1 
     75      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_2 
     76      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_2 
     77      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1 
     78      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2 
     79      CHARACTER(len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array 
     80      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo1 
     81      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo2 
     82      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo3 
     83      INTEGER                             , INTENT(in), OPTIONAL ::   kdim 
     84      ! 
     85      CHARACTER(len=30) :: cl1, cl2 
     86      INTEGER ::  jn, jl, kdir 
     87      INTEGER ::  iis, iie, jjs, jje 
     88      INTEGER ::  itra, inum 
    9289      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    93       REAL(wp), DIMENSION(jpi,jpj)     :: ztab2d_1, ztab2d_2 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 
    95       !!---------------------------------------------------------------------- 
    96  
     90      !!---------------------------------------------------------------------- 
     91      ! 
    9792      ! Arrays, scalars initialization  
    98       kdir      = jpkm1 
    99       cl2       = '' 
    100       zsum1     = 0.e0 
    101       zsum2     = 0.e0 
    102       zvctl1    = 0.e0 
    103       zvctl2    = 0.e0 
    104       ztab2d_1(:,:)   = 0.e0 
    105       ztab2d_2(:,:)   = 0.e0 
    106       ztab3d_1(:,:,:) = 0.e0 
    107       ztab3d_2(:,:,:) = 0.e0 
    108       zmask1  (:,:,:) = 1.e0 
    109       zmask2  (:,:,:) = 1.e0 
     93      cl1  = '' 
     94      cl2  = '' 
     95      kdir = jpkm1 
     96      itra = 1 
    11097 
    11198      ! Control of optional arguments 
    112       IF( PRESENT(clinfo2) )   cl2                  = clinfo2 
    113       IF( PRESENT(kdim)    )   kdir                 = kdim 
    114       IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:) 
    115       IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:) 
    116       IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,1:kdir) 
    117       IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir) 
    118       IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:) 
    119       IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:) 
    120  
    121       IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number 
    122          sind = narea 
    123          eind = narea 
    124       ELSE                                    ! processors total number 
    125          sind = 1 
    126          eind = ijsplt 
    127       ENDIF 
     99      IF( PRESENT(clinfo1) )   cl1  = clinfo1 
     100      IF( PRESENT(clinfo2) )   cl2  = clinfo2 
     101      IF( PRESENT(kdim)    )   kdir = kdim 
     102      IF( PRESENT(tab4d_1) )   itra = SIZE(tab4d_1,dim=4) 
    128103 
    129104      ! Loop over each sub-domain, i.e. the total number of processors ijsplt 
    130       DO jn = sind, eind 
    131          ! Set logical unit 
    132          j_id = numid(jn - narea + 1) 
    133          ! Set indices for the SUM control 
    134          IF( .NOT. lsp_area ) THEN 
    135             IF (lk_mpp .AND. jpnij > 1)   THEN 
    136                nictls = MAX(  1, nis0allp(jn) ) 
    137                nictle = MIN(jpi, nie0allp(jn) ) 
    138                njctls = MAX(  1, njs0allp(jn) ) 
    139                njctle = MIN(jpj, nje0allp(jn) ) 
    140                ! Do not take into account the bound of the domain 
    141                IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    142                IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    143                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nie0allp(jn) - 1) 
    144                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nje0allp(jn) - 1) 
     105      DO jl = 1, SIZE(nall_ictls) 
     106 
     107         ! define shoter names... 
     108         iis = nall_ictls(jl) 
     109         iie = nall_ictle(jl) 
     110         jjs = nall_jctls(jl) 
     111         jje = nall_jctle(jl) 
     112 
     113         IF( PRESENT(clinfo) ) THEN   ;   inum = numprt_top(jl) 
     114         ELSE                         ;   inum = numprt_oce(jl) 
     115         ENDIF 
     116 
     117         DO jn = 1, itra 
     118 
     119            IF( PRESENT(clinfo3) ) THEN 
     120               IF    ( clinfo3 == 'tra-ta' )   THEN 
     121                  zvctl1 = t_ctl(jl) 
     122               ELSEIF( clinfo3 == 'tra'    )   THEN 
     123                  zvctl1 = t_ctl(jl) 
     124                  zvctl2 = s_ctl(jl) 
     125               ELSEIF( clinfo3 == 'dyn'    )   THEN 
     126                  zvctl1 = u_ctl(jl) 
     127                  zvctl2 = v_ctl(jl) 
     128               ELSE 
     129                  zvctl1 = tra_ctl(jn,jl) 
     130               ENDIF 
     131            ENDIF 
     132 
     133            ! 2D arrays 
     134            IF( PRESENT(tab2d_1) ) THEN 
     135               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 
     136               ELSE                        ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje)                            ) 
     137               ENDIF 
     138            ENDIF 
     139            IF( PRESENT(tab2d_2) ) THEN 
     140               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 
     141               ELSE                        ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje)                            ) 
     142               ENDIF 
     143            ENDIF 
     144 
     145            ! 3D arrays 
     146            IF( PRESENT(tab3d_1) ) THEN 
     147               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     148               ELSE                        ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir)                                 ) 
     149               ENDIF 
     150            ENDIF 
     151            IF( PRESENT(tab3d_2) ) THEN 
     152               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 
     153               ELSE                        ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir)                                 ) 
     154               ENDIF 
     155            ENDIF 
     156 
     157            ! 4D arrays 
     158            IF( PRESENT(tab4d_1) ) THEN 
     159               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     160               ELSE                        ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn)                                 ) 
     161               ENDIF 
     162            ENDIF 
     163 
     164            ! Print the result 
     165            IF( PRESENT(clinfo ) )   cl1  = clinfo(jn) 
     166            IF( PRESENT(clinfo3) )   THEN 
     167               ! 
     168               IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 
     169                  WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 
     170               ELSE 
     171                  WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1 
     172               ENDIF 
     173               ! 
     174               SELECT CASE( clinfo3 ) 
     175               CASE ( 'tra-ta' )  
     176                  t_ctl(jl) = zsum1 
     177               CASE ( 'tra' )  
     178                  t_ctl(jl) = zsum1 
     179                  s_ctl(jl) = zsum2 
     180               CASE ( 'dyn' )  
     181                  u_ctl(jl) = zsum1 
     182                  v_ctl(jl) = zsum2 
     183               CASE default 
     184                  tra_ctl(jn,jl) = zsum1 
     185               END SELECT 
     186            ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
     187               WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 
    145188            ELSE 
    146                nictls = MAX(  1, nimpptl(jn) - 1 + nis0allp(jn) ) 
    147                nictle = MIN(jpi, nimpptl(jn) - 1 + nie0allp(jn) ) 
    148                njctls = MAX(  1, njmpptl(jn) - 1 + njs0allp(jn) ) 
    149                njctle = MIN(jpj, njmpptl(jn) - 1 + nje0allp(jn) ) 
    150                ! Do not take into account the bound of the domain 
    151                IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    152                IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    153                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nie0allp(jn) - 2) 
    154                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nje0allp(jn) - 2) 
    155             ENDIF 
    156          ENDIF 
    157  
    158          IF( PRESENT(clinfo3)) THEN 
    159             IF ( clinfo3 == 'tra' )  THEN 
    160                zvctl1 = t_ctll(jn) 
    161                zvctl2 = s_ctll(jn) 
    162             ELSEIF ( clinfo3 == 'dyn' )   THEN 
    163                zvctl1 = u_ctll(jn) 
    164                zvctl2 = v_ctll(jn) 
    165             ENDIF 
    166          ENDIF 
    167  
    168          ! Compute the sum control 
    169          ! 2D arrays 
    170          IF( PRESENT(tab2d_1) )   THEN 
    171             zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) ) 
    172             zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) ) 
    173          ENDIF 
    174  
    175          ! 3D arrays 
    176          IF( PRESENT(tab3d_1) )   THEN 
    177             zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) ) 
    178             zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) ) 
    179          ENDIF 
    180  
    181          ! Print the result 
    182          IF( PRESENT(clinfo3) )   THEN 
    183             WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2 
    184             SELECT CASE( clinfo3 ) 
    185             CASE ( 'tra-ta' )  
    186                t_ctll(jn) = zsum1 
    187             CASE ( 'tra' )  
    188                 t_ctll(jn) = zsum1 
    189                 s_ctll(jn) = zsum2 
    190             CASE ( 'dyn' )  
    191                 u_ctll(jn) = zsum1 
    192                 v_ctll(jn) = zsum2  
    193             END SELECT 
    194          ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
    195             WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2 
    196          ELSE 
    197             WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1 
    198          ENDIF 
    199  
    200       ENDDO 
    201       ! 
    202    END SUBROUTINE prt_ctl 
    203  
    204  
    205    SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime) 
    206       !!---------------------------------------------------------------------- 
    207       !!                     ***  ROUTINE prt_ctl_info  *** 
    208       !! 
    209       !! ** Purpose : - print information without any computation 
    210       !! 
    211       !! ** Action  : - input arguments 
    212       !!                    clinfo1 : information about the ivar1 
    213       !!                    ivar1   : value to print 
    214       !!                    clinfo2 : information about the ivar2 
    215       !!                    ivar2   : value to print 
    216       !!---------------------------------------------------------------------- 
    217       CHARACTER (len=*), INTENT(in)           ::   clinfo1 
    218       INTEGER          , INTENT(in), OPTIONAL ::   ivar1 
    219       CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2 
    220       INTEGER          , INTENT(in), OPTIONAL ::   ivar2 
    221       INTEGER          , INTENT(in), OPTIONAL ::   itime 
    222       ! 
    223       INTEGER :: jn, sind, eind, iltime, j_id 
    224       !!---------------------------------------------------------------------- 
    225  
    226       IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number 
    227          sind = narea 
    228          eind = narea 
    229       ELSE                                    ! total number of processors 
    230          sind = 1 
    231          eind = ijsplt 
    232       ENDIF 
    233  
    234       ! Set to zero arrays at each new time step 
    235       IF( PRESENT(itime) )   THEN 
    236          iltime = itime 
    237          IF( iltime > ktime )   THEN 
    238             t_ctll(:) = 0.e0   ;   s_ctll(:) = 0.e0 
    239             u_ctll(:) = 0.e0   ;   v_ctll(:) = 0.e0 
    240             ktime = iltime 
    241          ENDIF 
    242       ENDIF 
    243  
    244       ! Loop over each sub-domain, i.e. number of processors ijsplt 
    245       DO jn = sind, eind 
    246          ! 
    247          j_id = numid(jn - narea + 1)         ! Set logical unit 
    248          ! 
    249          IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    250             WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2 
    251          ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN 
    252             WRITE(j_id,*)clinfo1, ivar1, clinfo2 
    253          ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    254             WRITE(j_id,*)clinfo1, ivar1, ivar2 
    255          ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN 
    256             WRITE(j_id,*)clinfo1, ivar1 
    257          ELSE 
    258             WRITE(j_id,*)clinfo1 
    259          ENDIF 
    260          ! 
    261       END DO 
    262       ! 
    263    END SUBROUTINE prt_ctl_info 
    264  
    265  
    266    SUBROUTINE prt_ctl_init 
    267       !!---------------------------------------------------------------------- 
    268       !!                     ***  ROUTINE prt_ctl_init  *** 
    269       !! 
    270       !! ** Purpose :   open ASCII files & compute indices 
    271       !!---------------------------------------------------------------------- 
    272       INTEGER ::   jn, sind, eind, j_id 
    273       CHARACTER (len=28) :: clfile_out 
    274       CHARACTER (len=23) :: clb_name 
    275       CHARACTER (len=19) :: cl_run 
    276       !!---------------------------------------------------------------------- 
    277  
    278       ! Allocate arrays 
    279       ALLOCATE( nis0allp(ijsplt) , nie0allp(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
    280          &      njs0allp(ijsplt) , nje0allp(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
    281          &       jpiallp(ijsplt) ,   t_ctll(ijsplt) ,  u_ctll(ijsplt) ,                     & 
    282          &       jpjallp(ijsplt) ,   s_ctll(ijsplt) ,  v_ctll(ijsplt)                       ) 
    283  
    284       ! Initialization  
    285       t_ctll(:) = 0.e0 
    286       s_ctll(:) = 0.e0 
    287       u_ctll(:) = 0.e0 
    288       v_ctll(:) = 0.e0 
    289       ktime = 1 
    290  
    291       IF( lk_mpp .AND. jpnij > 1 ) THEN 
    292          sind = narea 
    293          eind = narea 
    294          clb_name = "('mpp.output_',I4.4)" 
    295          cl_run = 'MULTI processor run' 
    296          ! use indices for each area computed by mpp_init subroutine 
    297          nis0allp(1:jpnij) = nis0all(:)  
    298          nie0allp(1:jpnij) = nie0all(:)  
    299          njs0allp(1:jpnij) = njs0all(:)  
    300          nje0allp(1:jpnij) = nje0all(:)  
    301          ! 
    302          nimpptl(1:jpnij) = nimppt(:) 
    303          njmpptl(1:jpnij) = njmppt(:) 
    304          ! 
    305          jpiallp(1:jpnij) = jpiall(:) 
    306          jpjallp(1:jpnij) = jpjall(:) 
    307          ! 
    308          ibonitl(1:jpnij) = ibonit(:) 
    309          ibonjtl(1:jpnij) = ibonjt(:) 
    310       ELSE 
    311          sind = 1 
    312          eind = ijsplt 
    313          clb_name = "('mono.output_',I4.4)" 
    314          cl_run = 'MONO processor run ' 
    315          ! compute indices for each area as done in mpp_init subroutine 
    316          CALL sub_dom 
    317       ENDIF 
    318  
    319       ALLOCATE( numid(eind-sind+1) ) 
    320  
    321       DO jn = sind, eind 
    322          WRITE(clfile_out,FMT=clb_name) jn-1 
    323          CALL ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. ) 
    324          j_id = numid(jn -narea + 1) 
    325          WRITE(j_id,*) 
    326          WRITE(j_id,*) '                 L O D Y C - I P S L' 
    327          WRITE(j_id,*) '                     O P A model' 
    328          WRITE(j_id,*) '            Ocean General Circulation Model' 
    329          WRITE(j_id,*) '               version OPA 9.0  (2005) ' 
    330          WRITE(j_id,*) 
    331          WRITE(j_id,*) '                   PROC number: ', jn 
    332          WRITE(j_id,*) 
    333          WRITE(j_id,FMT="(19x,a20)")cl_run 
    334  
    335          ! Print the SUM control indices 
    336          IF( .NOT. lsp_area )   THEN 
    337             nictls = nimpptl(jn) + nis0allp(jn) - 1 
    338             nictle = nimpptl(jn) + nie0allp(jn) - 1 
    339             njctls = njmpptl(jn) + njs0allp(jn) - 1 
    340             njctle = njmpptl(jn) + nje0allp(jn) - 1 
    341          ENDIF 
    342          WRITE(j_id,*)  
    343          WRITE(j_id,*) 'prt_ctl :  Sum control indices' 
    344          WRITE(j_id,*) '~~~~~~~' 
    345          WRITE(j_id,*) 
    346          WRITE(j_id,9000)'                                Nje0   = ', nje0allp(jn), '              ' 
    347          WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------' 
    348          WRITE(j_id,9001)'                  |                                       |' 
    349          WRITE(j_id,9001)'                  |                                       |' 
    350          WRITE(j_id,9001)'                  |                                       |' 
    351          WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle 
    352          WRITE(j_id,9002)'           Nis0   = ', nis0allp(jn),  '                           Nie0   = ', nie0allp(jn) 
    353          WRITE(j_id,9001)'                  |                                       |' 
    354          WRITE(j_id,9001)'                  |                                       |' 
    355          WRITE(j_id,9001)'                  |                                       |' 
    356          WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------' 
    357          WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        Njs0   = ', njs0allp(jn), '              ' 
    358          WRITE(j_id,*) 
    359          WRITE(j_id,*) 
    360  
    361 9000     FORMAT(a41,i4.4,a14) 
    362 9001     FORMAT(a59) 
    363 9002     FORMAT(a20,i4.4,a36,i3.3) 
    364 9003     FORMAT(a20,i4.4,a17,i4.4) 
    365 9004     FORMAT(a11,i4.4,a26,i4.4,a14) 
    366       END DO 
    367       ! 
    368    END SUBROUTINE prt_ctl_init 
    369  
    370  
    371    SUBROUTINE sub_dom 
    372       !!---------------------------------------------------------------------- 
    373       !!                  ***  ROUTINE sub_dom  *** 
    374       !!                     
    375       !! ** Purpose :   Lay out the global domain over processors.  
    376       !!                CAUTION:  
    377       !!                This part has been extracted from the mpp_init 
    378       !!                subroutine and names of variables/arrays have been  
    379       !!                slightly changed to avoid confusion but the computation 
    380       !!                is exactly the same. Any modification about indices of 
    381       !!                each sub-domain in the mppini.F90 module should be reported  
    382       !!                here. 
    383       !! 
    384       !! ** Method  :   Global domain is distributed in smaller local domains. 
    385       !!                Periodic condition is a function of the local domain position 
    386       !!                (global boundary or neighbouring domain) and of the global 
    387       !!                periodic 
    388       !!                Type :         jperio global periodic condition 
    389       !! 
    390       !! ** Action  : - set domain parameters 
    391       !!                    nimpp     : longitudinal index  
    392       !!                    njmpp     : latitudinal  index 
    393       !!                    narea     : number for local area 
    394       !!                    ipil      : first dimension 
    395       !!                    ipjl      : second dimension 
    396       !!                    nbondil    : mark for "east-west local boundary" 
    397       !!                    nbondjl    : mark for "north-south local boundary" 
    398       !! 
    399       !! History : 
    400       !!        !  94-11  (M. Guyon)  Original code 
    401       !!        !  95-04  (J. Escobar, M. Imbard) 
    402       !!        !  98-02  (M. Guyon)  FETI method 
    403       !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    404       !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    405       !!---------------------------------------------------------------------- 
    406       INTEGER ::   ji, jj, jn               ! dummy loop indices 
    407       INTEGER ::   & 
    408          ii, ij,                         &  ! temporary integers 
    409          irestil, irestjl,               &  !    "          " 
    410          ijpi  , ijpj, ipil,             &  ! temporary logical unit 
    411          ipjl , nbondil, nbondjl,        & 
    412          nrecil, nrecjl, Nis0l, Nie0l, Njs0l, Nje0l 
    413  
    414       INTEGER, DIMENSION(jpi,jpj) ::   iimpptl, ijmpptl, ijpitl, ijpjtl   ! workspace 
    415       REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    416       INTEGER ::   inum                     ! local logical unit 
    417       !!---------------------------------------------------------------------- 
    418  
    419       ! 
    420       ! 
    421       !  1. Dimension arrays for subdomains 
    422       ! ----------------------------------- 
    423       !  Computation of local domain sizes ijpitl() ijpjtl() 
    424       !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 
    425       !  The subdomains are squares leeser than or equal to the global 
    426       !  dimensions divided by the number of processors minus the overlap 
    427       !  array (cf. par_oce.F90). 
    428  
    429 #if defined key_nemocice_decomp 
    430       ijpi = ( nx_global+2-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 
    431       ijpj = ( ny_global+2-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls  
    432 #else 
    433       ijpi = ( jpiglo-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 
    434       ijpj = ( jpjglo-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls 
    435 #endif 
    436  
    437  
    438       nrecil  = 2 * nn_hls 
    439       nrecjl  = 2 * nn_hls 
    440       irestil = MOD( jpiglo - nrecil , isplt ) 
    441       irestjl = MOD( jpjglo - nrecjl , jsplt ) 
    442  
    443       IF(  irestil == 0 )   irestil = isplt 
    444 #if defined key_nemocice_decomp 
    445  
    446       ! In order to match CICE the size of domains in NEMO has to be changed 
    447       ! The last line of blocks (west) will have fewer points  
    448       DO jj = 1, jsplt  
    449          DO ji=1, isplt-1  
    450             ijpitl(ji,jj) = ijpi  
    451          END DO  
    452          ijpitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 
    453       END DO  
    454  
    455 #else  
    456  
    457       DO jj = 1, jsplt 
    458          DO ji = 1, irestil 
    459             ijpitl(ji,jj) = ijpi 
    460          END DO 
    461          DO ji = irestil+1, isplt 
    462             ijpitl(ji,jj) = ijpi -1 
     189               WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 
     190            ENDIF 
     191 
    463192         END DO 
    464193      END DO 
    465  
    466 #endif 
    467        
    468       IF( irestjl == 0 )   irestjl = jsplt 
    469 #if defined key_nemocice_decomp  
    470  
    471       ! Same change to domains in North-South direction as in East-West.  
    472       DO ji = 1, isplt  
    473          DO jj=1, jsplt-1  
    474             ijpjtl(ji,jj) = ijpj  
    475          END DO  
    476          ijpjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 
    477       END DO  
    478  
    479 #else  
    480  
    481       DO ji = 1, isplt 
    482          DO jj = 1, irestjl 
    483             ijpjtl(ji,jj) = ijpj 
    484          END DO 
    485          DO jj = irestjl+1, jsplt 
    486             ijpjtl(ji,jj) = ijpj -1 
    487          END DO 
     194      ! 
     195   END SUBROUTINE prt_ctl 
     196 
     197 
     198   SUBROUTINE prt_ctl_info (clinfo, ivar, cdcomp ) 
     199      !!---------------------------------------------------------------------- 
     200      !!                     ***  ROUTINE prt_ctl_info  *** 
     201      !! 
     202      !! ** Purpose : - print information without any computation 
     203      !! 
     204      !! ** Action  : - input arguments 
     205      !!                    clinfo : information about the ivar 
     206      !!                    ivar   : value to print 
     207      !!---------------------------------------------------------------------- 
     208      CHARACTER(len=*),           INTENT(in) ::   clinfo 
     209      INTEGER         , OPTIONAL, INTENT(in) ::   ivar 
     210      CHARACTER(len=3), OPTIONAL, INTENT(in) ::   cdcomp   ! only 'top' is accepted 
     211      ! 
     212      CHARACTER(len=3) :: clcomp 
     213      INTEGER ::  jl, inum 
     214      !!---------------------------------------------------------------------- 
     215      ! 
     216      IF( PRESENT(cdcomp) ) THEN   ;   clcomp = cdcomp 
     217      ELSE                         ;   clcomp = 'oce' 
     218      ENDIF 
     219      ! 
     220      DO jl = 1, SIZE(nall_ictls) 
     221         ! 
     222         IF( clcomp == 'oce' )   inum = numprt_oce(jl) 
     223         IF( clcomp == 'top' )   inum = numprt_top(jl) 
     224         ! 
     225         IF ( PRESENT(ivar) ) THEN   ;   WRITE(inum,*) clinfo, ivar 
     226         ELSE                        ;   WRITE(inum,*) clinfo 
     227         ENDIF 
     228         ! 
    488229      END DO 
    489  
    490 #endif 
    491       zidom = nrecil 
    492       DO ji = 1, isplt 
    493          zidom = zidom + ijpitl(ji,1) - nrecil 
     230      ! 
     231   END SUBROUTINE prt_ctl_info 
     232 
     233 
     234   SUBROUTINE prt_ctl_init( cdcomp, kntra ) 
     235      !!---------------------------------------------------------------------- 
     236      !!                     ***  ROUTINE prt_ctl_init  *** 
     237      !! 
     238      !! ** Purpose :   open ASCII files & compute indices 
     239      !!---------------------------------------------------------------------- 
     240      CHARACTER(len=3), OPTIONAL, INTENT(in   ) ::   cdcomp   ! only 'top' is accepted 
     241      INTEGER         , OPTIONAL, INTENT(in   ) ::   kntra    ! only for 'top': number of tracers 
     242      ! 
     243      INTEGER ::   ji, jj, jl 
     244      INTEGER ::   inum, idg, idg2 
     245      INTEGER ::   ijsplt, iimax, ijmax 
     246      INTEGER, DIMENSION(:,:), ALLOCATABLE ::    iimppt, ijmppt, ijpi, ijpj, iproc 
     247      INTEGER, DIMENSION(  :), ALLOCATABLE ::     iipos,  ijpos 
     248      LOGICAL, DIMENSION(:,:), ALLOCATABLE ::   llisoce 
     249      CHARACTER(len=64) :: clfile_out 
     250      CHARACTER(LEN=64) :: clfmt, clfmt2, clfmt3, clfmt4 
     251      CHARACTER(len=32) :: clname, cl_run 
     252      CHARACTER(len= 3) :: clcomp 
     253      !!---------------------------------------------------------------------- 
     254      ! 
     255      clname = 'output' 
     256      IF( PRESENT(cdcomp) ) THEN 
     257         clname = TRIM(clname)//'.'//TRIM(cdcomp) 
     258         clcomp = cdcomp 
     259      ELSE 
     260         clcomp = 'oce' 
     261      ENDIF 
     262      ! 
     263      IF( jpnij > 1 ) THEN   ! MULTI processor run 
     264         cl_run = 'MULTI processor run' 
     265         idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )    ! how many digits to we need to write? min=4, max=9 
     266         WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg        ! '(a,ix.x)' 
     267         WRITE(clfile_out,clfmt) 'mpp.'//trim(clname)//'_', narea - 1 
     268         ijsplt = 1 
     269      ELSE                   ! MONO processor run 
     270         cl_run = 'MONO processor run ' 
     271         IF(lwp) THEN                  ! control print 
     272            WRITE(numout,*) 
     273            WRITE(numout,*) 'prt_ctl_init: sn_cfctl%l_prtctl parameters' 
     274            WRITE(numout,*) '~~~~~~~~~~~~~' 
     275         ENDIF 
     276         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area          
     277            nn_isplt = MAX(1, nn_isplt)            ! number of processors following i-direction 
     278            nn_jsplt = MAX(1, nn_jsplt)            ! number of processors following j-direction 
     279            ijsplt = nn_isplt * nn_jsplt           ! total number of processors ijsplt 
     280            IF( ijsplt == 1 )   CALL ctl_warn( 'nn_isplt & nn_jsplt are equal to 1 -> control sum done over the whole domain' ) 
     281            IF(lwp) WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
     282            IF(lwp) WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
     283            idg = MAX( INT(LOG10(REAL(MAX(1,ijsplt-1),wp))) + 1, 4 )    ! how many digits to we need to write? min=4, max=9 
     284            WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg         ! '(a,ix.x)' 
     285            IF( ijsplt == 1 ) WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', 0 
     286         ELSE                                             ! print control done over a specific  area 
     287            ijsplt = 1 
     288            IF( nn_ictls < 1 .OR. nn_ictls > Ni0glo )   THEN 
     289               CALL ctl_warn( '          - nictls must be 1<=nictls>=Ni0glo, it is forced to 1' ) 
     290               nn_ictls = 1 
     291            ENDIF 
     292            IF( nn_ictle < 1 .OR. nn_ictle > Ni0glo )   THEN 
     293               CALL ctl_warn( '          - nictle must be 1<=nictle>=Ni0glo, it is forced to Ni0glo' ) 
     294               nn_ictle = Ni0glo 
     295            ENDIF 
     296            IF( nn_jctls < 1 .OR. nn_jctls > Nj0glo )   THEN 
     297               CALL ctl_warn( '          - njctls must be 1<=njctls>=Nj0glo, it is forced to 1' ) 
     298               nn_jctls = 1 
     299            ENDIF 
     300            IF( nn_jctle < 1 .OR. nn_jctle > Nj0glo )   THEN 
     301               CALL ctl_warn( '          - njctle must be 1<=njctle>=Nj0glo, it is forced to Nj0glo' ) 
     302               nn_jctle = Nj0glo 
     303            ENDIF 
     304            WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
     305            WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
     306            WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
     307            WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
     308            idg = MAXVAL( (/ nn_ictls,nn_ictle,nn_jctls,nn_jctle /) )   ! temporary use of idg to store the largest index 
     309            idg = MAX( INT(LOG10(REAL(idg,wp))) + 1, 4 )                ! how many digits to we need to write? min=4, max=9 
     310            WRITE(clfmt, "('(4(a,i', i1, '.', i1, '))')") idg, idg         ! '(4(a,ix.x))' 
     311            WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', nn_ictls, '_', nn_ictle, '_', nn_jctls, '_', nn_jctle 
     312         ENDIF 
     313      ENDIF 
     314 
     315      ! Allocate arrays 
     316      IF( .NOT. ALLOCATED(nall_ictls) ) ALLOCATE( nall_ictls(ijsplt), nall_ictle(ijsplt), nall_jctls(ijsplt), nall_jctle(ijsplt) ) 
     317 
     318      IF( jpnij > 1 ) THEN   ! MULTI processor run 
     319         ! 
     320         nall_ictls(1) = Nis0 
     321         nall_ictle(1) = Nie0 
     322         nall_jctls(1) = Njs0 
     323         nall_jctle(1) = Nje0 
     324         ! 
     325      ELSE                   ! MONO processor run 
     326         ! 
     327         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area 
     328            ! 
     329            ALLOCATE(  iimppt(nn_isplt,nn_jsplt), ijmppt(nn_isplt,nn_jsplt),  ijpi(nn_isplt,nn_jsplt),  ijpj(nn_isplt,nn_jsplt),   & 
     330               &      llisoce(nn_isplt,nn_jsplt),  iproc(nn_isplt,nn_jsplt), iipos(nn_isplt*nn_jsplt), ijpos(nn_isplt*nn_jsplt) ) 
     331            CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, nn_isplt, nn_jsplt, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 
     332            CALL mpp_is_ocean( llisoce ) 
     333            CALL mpp_getnum( llisoce, iproc, iipos, ijpos ) 
     334            ! 
     335            DO jj = 1,nn_jsplt 
     336               DO ji = 1, nn_isplt 
     337                  jl = iproc(ji,jj) + 1 
     338                  nall_ictls(jl) = iimppt(ji,jj) - 1 +      1      + nn_hls 
     339                  nall_ictle(jl) = iimppt(ji,jj) - 1 + ijpi(ji,jj) - nn_hls 
     340                  nall_jctls(jl) = ijmppt(ji,jj) - 1 +      1      + nn_hls 
     341                  nall_jctle(jl) = ijmppt(ji,jj) - 1 + ijpj(ji,jj) - nn_hls 
     342               END DO 
     343            END DO 
     344            ! 
     345            DEALLOCATE( iimppt, ijmppt, ijpi, ijpj, llisoce, iproc, iipos, ijpos ) 
     346            ! 
     347         ELSE                                             ! print control done over a specific  area 
     348            ! 
     349            nall_ictls(1) = nn_ictls + nn_hls 
     350            nall_ictle(1) = nn_ictle + nn_hls 
     351            nall_jctls(1) = nn_jctls + nn_hls 
     352            nall_jctle(1) = nn_jctle + nn_hls 
     353            ! 
     354         ENDIF 
     355      ENDIF 
     356 
     357      ! Initialization  
     358      IF( clcomp == 'oce' ) THEN 
     359         ALLOCATE( t_ctl(ijsplt), s_ctl(ijsplt), u_ctl(ijsplt), v_ctl(ijsplt), numprt_oce(ijsplt) ) 
     360         t_ctl(:) = 0.e0 
     361         s_ctl(:) = 0.e0 
     362         u_ctl(:) = 0.e0 
     363         v_ctl(:) = 0.e0 
     364      ENDIF 
     365      IF( clcomp == 'top' ) THEN 
     366         ALLOCATE( tra_ctl(kntra,ijsplt), numprt_top(ijsplt) ) 
     367         tra_ctl(:,:) = 0.e0 
     368      ENDIF 
     369 
     370      DO jl = 1,ijsplt 
     371 
     372         IF( ijsplt > 1 ) WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', jl-1 
     373 
     374         CALL ctl_opn( inum, clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. ) 
     375         IF( clcomp == 'oce' )   numprt_oce(jl) = inum 
     376         IF( clcomp == 'top' )   numprt_top(jl) = inum 
     377         WRITE(inum,*) 
     378         WRITE(inum,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
     379         WRITE(inum,*) '                       NEMO team' 
     380         WRITE(inum,*) '            Ocean General Circulation Model' 
     381         IF( clcomp == 'oce' )   WRITE(inum,*) '                NEMO version 4.x  (2020) ' 
     382         IF( clcomp == 'top' )   WRITE(inum,*) '                 TOP vversion x (2020) ' 
     383         WRITE(inum,*) 
     384         IF( ijsplt > 1 )   & 
     385            &   WRITE(inum,*) '              MPI-subdomain number: ', jl-1 
     386         IF(  jpnij > 1 )   & 
     387            &   WRITE(inum,*) '              MPI-subdomain number: ', narea-1 
     388         WRITE(inum,*) 
     389         WRITE(inum,'(19x,a20)') cl_run 
     390         WRITE(inum,*)  
     391         WRITE(inum,*) 'prt_ctl :  Sum control indices' 
     392         WRITE(inum,*) '~~~~~~~' 
     393         WRITE(inum,*) 
     394         ! 
     395         ! clfmt2: '              ----- jctle = XXX (YYY) -----'             -> '(18x, 13a1, a9, iM, a2, iN, a2, 13a1)' 
     396         ! clfmt3: '              |                           |'             -> '(18x, a1, Nx, a1)' 
     397         ! clfmt4: '        ictls = XXX (YYY)           ictle = XXX (YYY)'   -> '(Nx, a9, iM, a2, iP, a2, Qx, a9, iM, a2, iP, a2)' 
     398         !         '              |                           |' 
     399         !         '              ----- jctle = XXX (YYY) -----' 
     400         ! clfmt5: '   njmpp = XXX'                                          -> '(Nx, a9, iM)' 
     401         ! clfmt6: '           nimpp = XXX'                                  -> '(Nx, a9, iM)' 
     402         ! 
     403         idg = MAXVAL( (/ nall_ictls(jl), nall_ictle(jl), nall_jctls(jl), nall_jctle(jl) /) )   ! temporary use of idg 
     404         idg = INT(LOG10(REAL(idg,wp))) + 1                                                     ! how many digits do we use? 
     405         idg2 = MAXVAL( (/ mig0(nall_ictls(jl)), mig0(nall_ictle(jl)), mjg0(nall_jctls(jl)), mjg0(nall_jctle(jl)) /) ) 
     406         idg2 = INT(LOG10(REAL(idg2,wp))) + 1                                                   ! how many digits do we use? 
     407         WRITE(clfmt2, "('(18x, 13a1, a9, i', i1, ', a2, i',i1,', a2, 13a1)')") idg, idg2 
     408         WRITE(clfmt3, "('(18x, a1, ', i2,'x, a1)')") 13+9+idg+2+idg2+2+13 - 2 
     409         WRITE(clfmt4, "('(', i2,'x, a9, i', i1,', a2, i', i1,', a2, ', i2,'x, a9, i', i1,', a2, i', i1,', a2)')") & 
     410            &          18-7, idg, idg2, 13+9+idg+2+idg2+2+13 - (2+idg+2+idg2+2+8), idg, idg2 
     411         WRITE(inum,clfmt2) ('-', ji=1,13), ' jctle = ', nall_jctle(jl), ' (', mjg0(nall_jctle(jl)), ') ', ('-', ji=1,13) 
     412         WRITE(inum,clfmt3) '|', '|' 
     413         WRITE(inum,clfmt3) '|', '|' 
     414         WRITE(inum,clfmt3) '|', '|' 
     415         WRITE(inum,clfmt4)                 ' ictls = ', nall_ictls(jl), ' (', mig0(nall_ictls(jl)), ') ',   & 
     416            &                               ' ictle = ', nall_ictle(jl), ' (', mig0(nall_ictle(jl)), ') ' 
     417         WRITE(inum,clfmt3) '|', '|' 
     418         WRITE(inum,clfmt3) '|', '|' 
     419         WRITE(inum,clfmt3) '|', '|' 
     420         WRITE(inum,clfmt2) ('-', ji=1,13), ' jctls = ', nall_jctls(jl), ' (', mjg0(nall_jctls(jl)), ') ', ('-', ji=1,13) 
     421         WRITE(inum,*) 
     422         WRITE(inum,*) 
     423         ! 
    494424      END DO 
    495       IF(lwp) WRITE(numout,*) 
    496       IF(lwp) WRITE(numout,*)' sum ijpitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 
    497        
    498       zjdom = nrecjl 
    499       DO jj = 1, jsplt 
    500          zjdom = zjdom + ijpjtl(1,jj) - nrecjl 
    501       END DO 
    502       IF(lwp) WRITE(numout,*)' sum ijpitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo 
    503       IF(lwp) WRITE(numout,*) 
    504        
    505  
    506       !  2. Index arrays for subdomains 
    507       ! ------------------------------- 
    508  
    509       iimpptl(:,:) = 1 
    510       ijmpptl(:,:) = 1 
    511        
    512       IF( isplt > 1 ) THEN 
    513          DO jj = 1, jsplt 
    514             DO ji = 2, isplt 
    515                iimpptl(ji,jj) = iimpptl(ji-1,jj) + ijpitl(ji-1,jj) - nrecil 
    516             END DO 
    517          END DO 
    518       ENDIF 
    519  
    520       IF( jsplt > 1 ) THEN 
    521          DO jj = 2, jsplt 
    522             DO ji = 1, isplt 
    523                ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ijpjtl(ji,jj-1)-nrecjl 
    524             END DO 
    525          END DO 
    526       ENDIF 
    527        
    528       ! 3. Subdomain description 
    529       ! ------------------------ 
    530  
    531       DO jn = 1, ijsplt 
    532          ii = 1 + MOD( jn-1, isplt ) 
    533          ij = 1 + (jn-1) / isplt 
    534          nimpptl(jn) = iimpptl(ii,ij) 
    535          njmpptl(jn) = ijmpptl(ii,ij) 
    536          jpiallp(jn) = ijpitl (ii,ij)      
    537          ipil        = jpiallp(jn)      
    538          jpjallp(jn) = ijpjtl (ii,ij)      
    539          ipjl        = jpjallp(jn) 
    540          nbondjl = -1                                    ! general case 
    541          IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor 
    542          IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor 
    543          IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction 
    544          ibonjtl(jn) = nbondjl 
    545           
    546          nbondil = 0                                     !  
    547          IF( MOD( jn, isplt ) == 1 )   nbondil = -1      ! 
    548          IF( MOD( jn, isplt ) == 0 )   nbondil =  1      ! 
    549          IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction 
    550          ibonitl(jn) = nbondil 
    551           
    552          Nis0l =  1   + nn_hls 
    553          Nie0l = ipil - nn_hls 
    554          IF( nbondil == -1 .OR. nbondil == 2 )   Nis0l = 1 
    555          IF( nbondil ==  1 .OR. nbondil == 2 )   Nie0l = ipil 
    556          Njs0l =  1   + nn_hls 
    557          Nje0l = ipjl - nn_hls 
    558          IF( nbondjl == -1 .OR. nbondjl == 2 )   Njs0l = 1 
    559          IF( nbondjl ==  1 .OR. nbondjl == 2 )   Nje0l = ipjl 
    560          nis0allp(jn) = Nis0l 
    561          nie0allp(jn) = Nie0l 
    562          njs0allp(jn) = Njs0l 
    563          nje0allp(jn) = Nje0l 
    564       END DO 
    565       ! 
    566       ! Save processor layout in layout_prtctl.dat file  
    567       IF(lwp) THEN 
    568          CALL ctl_opn( inum, 'layout_prtctl.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    569          WRITE(inum,'(a)') 'nproc ipil ipjl Nis0l Njs0l Nie0l Nje0l nimpptl njmpptl ibonitl ibonjtl' 
    570          ! 
    571          DO jn = 1, ijsplt 
    572             WRITE(inum,'(i5,6i6,4i8)') jn-1, jpiallp(jn),  jpjallp(jn), & 
    573                &                            nis0allp(jn), njs0allp(jn), & 
    574                &                            nie0allp(jn), nje0allp(jn), & 
    575                &                             nimpptl(jn),  njmpptl(jn), & 
    576                &                             ibonitl(jn),  ibonjtl(jn) 
    577          END DO 
    578          CLOSE(inum)    
    579       END IF 
    580       ! 
    581       ! 
    582    END SUBROUTINE sub_dom 
     425      ! 
     426   END SUBROUTINE prt_ctl_init 
     427 
    583428 
    584429   !!====================================================================== 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90

    r13174 r13176  
    3232   PRIVATE 
    3333 
    34    PUBLIC   mpp_init   ! called by opa.F90 
    35  
     34   PUBLIC   mpp_init       ! called by nemogcm.F90 
     35   PUBLIC   mpp_getnum     ! called by prtctl 
     36   PUBLIC   mpp_basesplit  ! called by prtctl 
     37   PUBLIC   mpp_is_ocean   ! called by prtctl 
     38    
    3639   INTEGER ::   numbot = -1   ! 'bottom_level' local logical unit 
    3740   INTEGER ::   numbdy = -1   ! 'bdy_msk'      local logical unit 
    … …  
    7679      jpnj   = 1 
    7780      jpnij  = jpni*jpnj 
    78       nimpp  = 1           !  
     81      nn_hls = 1 
     82      nimpp  = 1 
    7983      njmpp  = 1 
    8084      nbondi = 2 
    … …  
    137141      INTEGER ::   ji, jj, jn, jproc, jarea   ! dummy loop indices 
    138142      INTEGER ::   inijmin 
    139       INTEGER ::   i2add 
    140143      INTEGER ::   inum                       ! local logical unit 
    141       INTEGER ::   idir, ifreq, icont         ! local integers 
     144      INTEGER ::   idir, ifreq                ! local integers 
    142145      INTEGER ::   ii, il1, ili, imil         !   -       - 
    143146      INTEGER ::   ij, il2, ilj, ijm1         !   -       - 
    … …  
    186189         ENDIF 
    187190            WRITE(numout,*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather 
     191            WRITE(numout,*) '      halo width (applies to both rows and columns)       nn_hls = ', nn_hls 
    188192      ENDIF 
    189193      ! 
    … …  
    225229         CALL bestpartition( mppsize, inbi, inbj, icnt2 )    ! best mpi decomposition for mppsize mpi processes 
    226230         ! largest subdomain size for mpi decoposition jpni*jpnj given in the namelist 
    227          CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax ) 
     231         CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax ) 
    228232         ! largest subdomain size for mpi decoposition inbi*inbj given by bestpartition 
    229          CALL basic_decomposition( jpiglo, jpjglo, nn_hls, inbi, inbj,  iimax,  ijmax ) 
     233         CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, inbi, inbj,  iimax,  ijmax ) 
    230234         icnt1 = jpni*jpnj - mppsize   ! number of land subdomains that should be removed to use mppsize mpi processes 
    231235         IF(lwp) THEN 
    … …  
    258262      ! look for land mpi subdomains... 
    259263      ALLOCATE( llisoce(jpni,jpnj) ) 
    260       CALL is_ocean( jpni, jpnj, llisoce ) 
     264      CALL mpp_is_ocean( llisoce ) 
    261265      inijmin = COUNT( llisoce )   ! number of oce subdomains 
    262266 
    … …  
    3163209003  FORMAT (a, i5) 
    317321 
    318       IF( numbot /= -1 )   CALL iom_close( numbot ) 
    319       IF( numbdy /= -1 )   CALL iom_close( numbdy ) 
    320        
    321322      ALLOCATE(  nfimpp(jpni ) , nfproc(jpni ) ,   nfjpi(jpni ) ,                     & 
    322323         &       nimppt(jpnij) , ibonit(jpnij) ,  jpiall(jpnij) ,  jpjall(jpnij) ,    & 
    … …  
    346347      ! ----------------------------------- 
    347348      ! 
    348       CALL basic_decomposition( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 
     349      CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 
     350      CALL mpp_getnum( llisoce, ipproc, iin, ijn ) 
     351      ! 
     352      nfproc(:) = ipproc(:,jpnj) 
    349353      nfimpp(:) = iimppt(:,jpnj) 
    350354      nfjpi (:) =   ijpi(:,jpnj) 
    … …  
    357361         WRITE(numout,*) '      jpni = ', jpni   
    358362         WRITE(numout,*) '      jpnj = ', jpnj 
     363         WRITE(numout,*) '     jpnij = ', jpnij 
    359364         WRITE(numout,*) 
    360365         WRITE(numout,*) '      sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo 
    … …  
    431436      ! ---------------------------- 
    432437      ! 
    433       ! specify which subdomains are oce subdomains; other are land subdomains 
    434       ipproc(:,:) = -1 
    435       icont = -1 
    436       DO jarea = 1, jpni*jpnj 
    437          iarea0 = jarea - 1 
    438          ii = 1 + MOD(iarea0,jpni) 
    439          ij = 1 +     iarea0/jpni 
    440          IF( llisoce(ii,ij) ) THEN 
    441             icont = icont + 1 
    442             ipproc(ii,ij) = icont 
    443             iin(icont+1) = ii 
    444             ijn(icont+1) = ij 
    445          ENDIF 
    446       END DO 
    447       ! if needed add some land subdomains to reach jpnij active subdomains 
    448       i2add = jpnij - inijmin 
    449       DO jarea = 1, jpni*jpnj 
    450          iarea0 = jarea - 1 
    451          ii = 1 + MOD(iarea0,jpni) 
    452          ij = 1 +     iarea0/jpni 
    453          IF( .NOT. llisoce(ii,ij) .AND. i2add > 0 ) THEN 
    454             icont = icont + 1 
    455             ipproc(ii,ij) = icont 
    456             iin(icont+1) = ii 
    457             ijn(icont+1) = ij 
    458             i2add = i2add - 1 
    459          ENDIF 
    460       END DO 
    461       nfproc(:) = ipproc(:,jpnj) 
    462  
    463438      ! neighbour treatment: change ibondi, ibondj if next to a land zone 
    464439      DO jarea = 1, jpni*jpnj 
    … …  
    655630         WRITE(numout,*) '      nimpp  = ', nimpp 
    656631         WRITE(numout,*) '      njmpp  = ', njmpp 
    657          WRITE(numout,*) '      nn_hls = ', nn_hls  
    658632      ENDIF 
    659633 
    … …  
    700674 
    701675 
    702     SUBROUTINE basic_decomposition( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
    703       !!---------------------------------------------------------------------- 
    704       !!                  ***  ROUTINE basic_decomposition  *** 
     676    SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
     677      !!---------------------------------------------------------------------- 
     678      !!                  ***  ROUTINE mpp_basesplit  *** 
    705679      !!                     
    706680      !! ** Purpose :   Lay out the global domain over processors. 
    … …  
    757731      klci(iresti+1:knbi ,:) = kimax-1 
    758732      IF( MINVAL(klci) < 2*i2hls ) THEN 
    759          WRITE(ctmp1,*) '   basic_decomposition: minimum value of jpi must be >= ', 2*i2hls 
     733         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 
    760734         WRITE(ctmp2,*) '   We have ', MINVAL(klci) 
    761735        CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    … …  
    775749      klcj(:,1:irestj) = kjmax 
    776750      IF( MINVAL(klcj) < 2*i2hls ) THEN 
    777          WRITE(ctmp1,*) '   basic_decomposition: minimum value of jpj must be >= ', 2*i2hls 
     751         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 
    778752         WRITE(ctmp2,*) '   We have ', MINVAL(klcj) 
    779753         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    … …  
    802776      ENDIF 
    803777       
    804    END SUBROUTINE basic_decomposition 
     778   END SUBROUTINE mpp_basesplit 
    805779 
    806780 
    … …  
    909883      iszij1(:) = iszi1(:) * iszj1(:) 
    910884 
    911       ! if therr is no land and no print 
     885      ! if there is no land and no print 
    912886      IF( .NOT. llist .AND. numbot == -1 .AND. numbdy == -1 ) THEN 
    913887         ! get the smaller partition which gives the smallest subdomain size 
    … …  
    957931         ji = isz0   ! initialization with the largest value 
    958932         ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 
    959          CALL is_ocean( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
     933         CALL mpp_is_ocean( llisoce )  ! Warning: must be call by all cores (call mpp_sum) 
    960934         inbijold = COUNT(llisoce) 
    961935         DEALLOCATE( llisoce ) 
    962936         DO ji =isz0-1,1,-1 
    963937            ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 
    964             CALL is_ocean( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
     938            CALL mpp_is_ocean( llisoce )  ! Warning: must be call by all cores (call mpp_sum) 
    965939            inbij = COUNT(llisoce) 
    966940            DEALLOCATE( llisoce ) 
    … …  
    988962         ii = ii -1  
    989963         ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 
    990          CALL is_ocean( inbi0(ii), inbj0(ii), llisoce )            ! must be done by all core 
     964         CALL mpp_is_ocean( llisoce )            ! must be done by all core 
    991965         inbij = COUNT(llisoce) 
    992966         DEALLOCATE( llisoce ) 
    … …  
    10521026    
    10531027    
    1054    SUBROUTINE is_ocean( knbi, knbj, ldisoce ) 
    1055       !!---------------------------------------------------------------------- 
    1056       !!                  ***  ROUTINE mpp_init_nboce  *** 
    1057       !! 
    1058       !! ** Purpose : Check for a mpi domain decomposition knbi x knbj which 
     1028   SUBROUTINE mpp_is_ocean( ldisoce ) 
     1029      !!---------------------------------------------------------------------- 
     1030      !!                  ***  ROUTINE mpp_is_ocean  *** 
     1031      !! 
     1032      !! ** Purpose : Check for a mpi domain decomposition inbi x inbj which 
    10591033      !!              subdomains, including 1 halo (even if nn_hls>1), contain 
    10601034      !!              at least 1 ocean point. 
    … …  
    10651039      !!              a subdomain with a closed boundary. 
    10661040      !! 
    1067       !! ** Method  : read knbj strips (of length Ni0glo) of the land-sea mask 
    1068       !!---------------------------------------------------------------------- 
    1069       INTEGER,                       INTENT(in   ) ::   knbi, knbj     ! domain decomposition 
    1070       LOGICAL, DIMENSION(knbi,knbj), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point  
    1071       ! 
    1072       INTEGER, DIMENSION(knbi,knbj) ::   inboce                        ! number oce oce pint in each mpi subdomain 
    1073       INTEGER, DIMENSION(knbi*knbj) ::   inboce_1d 
     1041      !! ** Method  : read inbj strips (of length Ni0glo) of the land-sea mask 
     1042      !!---------------------------------------------------------------------- 
     1043      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point  
     1044      ! 
    10741045      INTEGER :: idiv, iimax, ijmax, iarea 
    1075       INTEGER :: inx, iny, inry, isty 
     1046      INTEGER :: inbi, inbj, inx, iny, inry, isty 
    10761047      INTEGER :: ji, jn 
    1077       LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce                  ! lloce(i,j) = .true. if the point (i,j) is ocean  
     1048      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   inboce           ! number oce oce pint in each mpi subdomain 
     1049      INTEGER, ALLOCATABLE, DIMENSION(:  ) ::   inboce_1d 
    10781050      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi 
    10791051      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj 
     1052      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean  
    10801053      !!---------------------------------------------------------------------- 
    10811054      ! do nothing if there is no land-sea mask 
    … …  
    10841057         RETURN 
    10851058      ENDIF 
    1086  
    1087       ! we want to read knbj strips of the land-sea mask. -> pick up knbj processes every idiv processes starting at 1 
    1088       IF           ( knbj == 1 ) THEN   ;   idiv = mppsize 
    1089       ELSE IF ( mppsize < knbj ) THEN   ;   idiv = 1 
    1090       ELSE                              ;   idiv = ( mppsize - 1 ) / ( knbj - 1 ) 
    1091       ENDIF 
     1059      ! 
     1060      inbi = SIZE( ldisoce, dim = 1 ) 
     1061      inbj = SIZE( ldisoce, dim = 2 ) 
     1062      ! 
     1063      ! we want to read inbj strips of the land-sea mask. -> pick up inbj processes every idiv processes starting at 1 
     1064      IF           ( inbj == 1 ) THEN   ;   idiv = mppsize 
     1065      ELSE IF ( mppsize < inbj ) THEN   ;   idiv = 1 
     1066      ELSE                              ;   idiv = ( mppsize - 1 ) / ( inbj - 1 ) 
     1067      ENDIF 
     1068      ! 
     1069      ALLOCATE( inboce(inbi,inbj), inboce_1d(inbi*inbj) ) 
    10921070      inboce(:,:) = 0          ! default no ocean point found 
    1093  
    1094       DO jn = 0, (knbj-1)/mppsize   ! if mppsize < knbj : more strips than mpi processes (because of potential land domains) 
     1071      ! 
     1072      DO jn = 0, (inbj-1)/mppsize   ! if mppsize < inbj : more strips than mpi processes (because of potential land domains) 
    10951073         ! 
    10961074         iarea = (narea-1)/idiv + jn * mppsize + 1                     ! involed process number (starting counting at 1) 
    1097          IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= knbj ) THEN      ! beware idiv can be = to 1 
     1075         IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= inbj ) THEN      ! beware idiv can be = to 1 
    10981076            ! 
    1099             ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ijpi(knbi,knbj), ijpj(knbi,knbj) ) 
    1100             CALL basic_decomposition( Ni0glo, Nj0glo, 0, knbi, knbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 
     1077            ALLOCATE( iimppt(inbi,inbj), ijmppt(inbi,inbj), ijpi(inbi,inbj), ijpj(inbi,inbj) ) 
     1078            CALL mpp_basesplit( Ni0glo, Nj0glo, 0, inbi, inbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 
    11011079            ! 
    11021080            inx = Ni0glo + 2   ;   iny = ijpj(1,iarea) + 2             ! strip size + 1 halo on each direction (even if nn_hls>1) 
    11031081            ALLOCATE( lloce(inx, iny) )                                ! allocate the strip 
    1104             inry = iny - COUNT( (/ iarea == 1, iarea == knbj /) )      ! number of point to read in y-direction 
     1082            inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) )      ! number of point to read in y-direction 
    11051083            isty = 1 + COUNT( (/ iarea == 1 /) )                       ! read from the first or the second line? 
    11061084            CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) )   ! read the strip 
    … …  
    11131091               ENDIF 
    11141092            ENDIF 
    1115             IF( iarea == knbj ) THEN                                   ! the last line was not read 
     1093            IF( iarea == inbj ) THEN                                   ! the last line was not read 
    11161094               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity 
    11171095                  CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) )       !   read the first line -> last line of lloce 
    … …  
    11271105            ENDIF 
    11281106            ! 
    1129             DO  ji = 1, knbi 
     1107            DO  ji = 1, inbi 
    11301108               inboce(ji,iarea) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)+1,:) )   ! lloce as 2 points more than Ni0glo 
    11311109            END DO 
    … …  
    11371115      END DO 
    11381116    
    1139       inboce_1d = RESHAPE(inboce, (/ knbi*knbj /)) 
     1117      inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 
    11401118      CALL mpp_sum( 'mppini', inboce_1d ) 
    1141       inboce = RESHAPE(inboce_1d, (/knbi, knbj/)) 
     1119      inboce = RESHAPE(inboce_1d, (/inbi, inbj/)) 
    11421120      ldisoce(:,:) = inboce(:,:) /= 0 
    1143       ! 
    1144    END SUBROUTINE is_ocean 
     1121      DEALLOCATE(inboce, inboce_1d) 
     1122      ! 
     1123   END SUBROUTINE mpp_is_ocean 
    11451124    
    11461125    
    … …  
    11551134      !! ** Method  : read stipe of size (Ni0glo,...) 
    11561135      !!---------------------------------------------------------------------- 
    1157       INTEGER                         , INTENT(in   ) :: kjstr       ! starting j position of the reading 
    1158       INTEGER                         , INTENT(in   ) :: kjcnt       ! number of lines to read 
    1159       LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) :: ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
     1136      INTEGER                         , INTENT(in   ) ::   kjstr       ! starting j position of the reading 
     1137      INTEGER                         , INTENT(in   ) ::   kjcnt       ! number of lines to read 
     1138      LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::   ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
    11601139      ! 
    11611140      INTEGER                           ::   inumsave                ! local logical unit 
    … …  
    11801159      ! 
    11811160   END SUBROUTINE readbot_strip 
     1161 
     1162 
     1163   SUBROUTINE mpp_getnum( ldisoce, kproc, kipos, kjpos ) 
     1164      !!---------------------------------------------------------------------- 
     1165      !!                  ***  ROUTINE mpp_getnum  *** 
     1166      !! 
     1167      !! ** Purpose : give a number to each MPI subdomains (starting at 0) 
     1168      !! 
     1169      !! ** Method  : start from bottom left. First skip land subdomain, and finally use them if needed 
     1170      !!---------------------------------------------------------------------- 
     1171      LOGICAL, DIMENSION(:,:), INTENT(in   ) ::   ldisoce     ! F if land process 
     1172      INTEGER, DIMENSION(:,:), INTENT(  out) ::   kproc       ! subdomain number (-1 if supressed, starting at 0) 
     1173      INTEGER, DIMENSION(  :), INTENT(  out) ::   kipos       ! i-position of the subdomain (from 1 to jpni) 
     1174      INTEGER, DIMENSION(  :), INTENT(  out) ::   kjpos       ! j-position of the subdomain (from 1 to jpnj) 
     1175      ! 
     1176      INTEGER :: ii, ij, jarea, iarea0 
     1177      INTEGER :: icont, i2add , ini, inj, inij 
     1178      !!---------------------------------------------------------------------- 
     1179      ! 
     1180      ini = SIZE(ldisoce, dim = 1) 
     1181      inj = SIZE(ldisoce, dim = 2) 
     1182      inij = SIZE(kipos) 
     1183      ! 
     1184      ! specify which subdomains are oce subdomains; other are land subdomains 
     1185      kproc(:,:) = -1 
     1186      icont = -1 
     1187      DO jarea = 1, ini*inj 
     1188         iarea0 = jarea - 1 
     1189         ii = 1 + MOD(iarea0,ini) 
     1190         ij = 1 +     iarea0/ini 
     1191         IF( ldisoce(ii,ij) ) THEN 
     1192            icont = icont + 1 
     1193            kproc(ii,ij) = icont 
     1194            kipos(icont+1) = ii 
     1195            kjpos(icont+1) = ij 
     1196         ENDIF 
     1197      END DO 
     1198      ! if needed add some land subdomains to reach inij active subdomains 
     1199      i2add = inij - COUNT( ldisoce ) 
     1200      DO jarea = 1, ini*inj 
     1201         iarea0 = jarea - 1 
     1202         ii = 1 + MOD(iarea0,ini) 
     1203         ij = 1 +     iarea0/ini 
     1204         IF( .NOT. ldisoce(ii,ij) .AND. i2add > 0 ) THEN 
     1205            icont = icont + 1 
     1206            kproc(ii,ij) = icont 
     1207            kipos(icont+1) = ii 
     1208            kjpos(icont+1) = ij 
     1209            i2add = i2add - 1 
     1210         ENDIF 
     1211      END DO 
     1212      ! 
     1213   END SUBROUTINE mpp_getnum 
    11821214 
    11831215 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcfwb.F90

    r12489 r13176  
    186186            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    187187            ! 
    188             IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     188            IF( lwp ) THEN                   ! control print 
    189189               IF( z_fwf < 0._wp ) THEN 
    190190                  WRITE(numout,*)'   z_fwf < 0' 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_hgr.F90

    r13065 r13176  
    109109         CALL ctl_warn( ' GYRE used as Benchmark: e1=e2=106km, no need to adjust rn_Dt, ahm,aht ' ) 
    110110      ENDIF 
    111       IF( nprint==1 .AND. lwp )   THEN 
     111      IF( lwp )   THEN 
    112112         WRITE(numout,*) 'ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 
    113113         WRITE(numout,*) 'ze1deg', ze1deg, 'zlam0', zlam0, 'zphi0', zphi0 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/nemogcm.F90

    r13065 r13176  
    8484#endif 
    8585   ! 
     86   USE prtctl         ! Print control 
    8687   USE in_out_manager ! I/O manager 
    8788   USE lib_mpp        ! distributed memory computing 
    … …  
    272273      INTEGER ::   ios, ilocal_comm   ! local integers 
    273274      !! 
    274       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    275          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    276          &             ln_timing, ln_diacfl 
     275      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     276         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    277277      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    278278      !!---------------------------------------------------------------------- 
    … …  
    534534         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    535535         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    536          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    537          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    538          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    539          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    540          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    541          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    542          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    543536         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    544537         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    545538      ENDIF 
    546539      ! 
    547       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    548       nictls    = nn_ictls 
    549       nictle    = nn_ictle 
    550       njctls    = nn_jctls 
    551       njctle    = nn_jctle 
    552       isplt     = nn_isplt 
    553       jsplt     = nn_jsplt 
    554  
     540      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    555541      IF(lwp) THEN                  ! control print 
    556542         WRITE(numout,*) 
    … …  
    563549         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    564550      ENDIF 
    565       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    566       ! 
    567       !                             ! Parameter control 
    568       ! 
    569       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    570          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    571             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    572          ELSE 
    573             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    574                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    575                   &           ' - the print control will be done over the whole domain' ) 
    576             ENDIF 
    577             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    578          ENDIF 
    579          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    580          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    581          ! 
    582          !                              ! indices used for the SUM control 
    583          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    584             lsp_area = .FALSE. 
    585          ELSE                                             ! print control done over a specific  area 
    586             lsp_area = .TRUE. 
    587             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    588                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    589                nictls = 1 
    590             ENDIF 
    591             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    592                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    593                nictle = jpiglo 
    594             ENDIF 
    595             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    596                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    597                njctls = 1 
    598             ENDIF 
    599             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    600                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    601                njctle = jpjglo 
    602             ENDIF 
    603          ENDIF 
    604       ENDIF 
    605551      ! 
    606552      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/trc_oce.F90

    r12377 r13176  
    158158         zchl = zrgb(1,jc) 
    159159         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 ) 
    160          IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb 
    161160         IF( irgb /= jc ) THEN 
    162161            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OFF/nemogcm.F90

    r13015 r13176  
    179179      INTEGER ::   ios, ilocal_comm   ! local integers 
    180180      !! 
    181       NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              & 
    182          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    183          &             ln_timing, ln_diacfl 
     181      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     182         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle 
    184183      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    185184      !!---------------------------------------------------------------------- 
    … …  
    374373         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    375374         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    376          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    377          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    378          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    379          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    380          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    381          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    382          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    383375         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    384376         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    385377      ENDIF 
    386       ! 
    387       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    388       nictls    = nn_ictls 
    389       nictle    = nn_ictle 
    390       njctls    = nn_jctls 
    391       njctle    = nn_jctle 
    392       isplt     = nn_isplt 
    393       jsplt     = nn_jsplt 
    394  
     378 
     379      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    395380      IF(lwp) THEN                  ! control print 
    396381         WRITE(numout,*) 
    … …  
    402387         WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    403388         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr     = ', ln_use_jattr 
    404       ENDIF 
    405       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    406       ! 
    407       !                             ! Parameter control 
    408       ! 
    409       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    410          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    411             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    412          ELSE 
    413             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    414                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    415                   &           ' - the print control will be done over the whole domain' ) 
    416             ENDIF 
    417             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    418          ENDIF 
    419          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    420          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    421          ! 
    422          !                              ! indices used for the SUM control 
    423          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    424             lsp_area = .FALSE. 
    425          ELSE                                             ! print control done over a specific  area 
    426             lsp_area = .TRUE. 
    427             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    428                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    429                nictls = 1 
    430             ENDIF 
    431             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    432                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    433                nictle = jpiglo 
    434             ENDIF 
    435             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    436                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    437                njctls = 1 
    438             ENDIF 
    439             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    440                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    441                njctle = jpjglo 
    442             ENDIF 
    443          ENDIF 
    444389      ENDIF 
    445390      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAO/nemogcm.F90

    r12960 r13176  
    2929   USE sao_intp 
    3030   ! 
     31   USE prtctl         ! Print control 
    3132   USE in_out_manager ! I/O manager 
    3233   USE lib_mpp        ! distributed memory computing 
    … …  
    9394      INTEGER ::   ios, ilocal_comm   ! local integer 
    9495      ! 
    95       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    96          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    97          &             ln_timing, ln_diacfl 
     96      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     97         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    9898      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    9999      !!---------------------------------------------------------------------- 
    … …  
    270270         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    271271         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    272          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    273          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    274          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    275          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    276          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    277          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    278          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    279272         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    280273         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    281274      ENDIF 
    282275      ! 
    283       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    284       nictls    = nn_ictls 
    285       nictle    = nn_ictle 
    286       njctls    = nn_jctls 
    287       njctle    = nn_jctle 
    288       isplt     = nn_isplt 
    289       jsplt     = nn_jsplt 
    290  
     276      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    291277      IF(lwp) THEN                  ! control print 
    292278         WRITE(numout,*) 
    … …  
    298284         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    299285         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    300       ENDIF 
    301       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    302       ! 
    303       !                             ! Parameter control 
    304       ! 
    305       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    306          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    307             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    308          ELSE 
    309             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    310                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    311                   &           ' - the print control will be done over the whole domain' ) 
    312             ENDIF 
    313             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    314          ENDIF 
    315          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    316          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    317          ! 
    318          !                              ! indices used for the SUM control 
    319          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    320             lsp_area = .FALSE. 
    321          ELSE                                             ! print control done over a specific  area 
    322             lsp_area = .TRUE. 
    323             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    324                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    325                nictls = 1 
    326             ENDIF 
    327             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    328                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    329                nictle = jpiglo 
    330             ENDIF 
    331             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    332                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    333                njctls = 1 
    334             ENDIF 
    335             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    336                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    337                njctle = jpjglo 
    338             ENDIF 
    339          ENDIF 
    340286      ENDIF 
    341287      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAS/nemogcm.F90

    r13015 r13176  
    3535   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    3636   ! 
     37   USE prtctl         ! Print control 
    3738   USE in_out_manager ! I/O manager 
    3839   USE lib_mpp        ! distributed memory computing 
    … …  
    202203      INTEGER ::   ios, ilocal_comm   ! local integers 
    203204      !! 
    204       NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              & 
    205          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    206          &             ln_timing, ln_diacfl 
     205      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     206         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    207207      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    208208      !!---------------------------------------------------------------------- 
    … …  
    410410         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    411411         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    412          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    413          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    414          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    415          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    416          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    417          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    418          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    419412         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    420413         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    421414      ENDIF 
    422415      ! 
    423       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    424       nictls    = nn_ictls 
    425       nictle    = nn_ictle 
    426       njctls    = nn_jctls 
    427       njctle    = nn_jctle 
    428       isplt     = nn_isplt 
    429       jsplt     = nn_jsplt 
    430  
     416      IF( .NOT.ln_read_cfg )   ln_closea = .FALSE.   ! dealing possible only with a domcfg file 
    431417      IF(lwp) THEN                  ! control print 
    432418         WRITE(numout,*) 
    … …  
    439425         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    440426      ENDIF 
    441       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    442       ! 
    443       !                             ! Parameter control 
    444       ! 
    445       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    446          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    447             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    448          ELSE 
    449             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    450                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    451                   &           ' - the print control will be done over the whole domain' ) 
    452             ENDIF 
    453             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    454          ENDIF 
    455          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    456          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    457          ! 
    458          !                              ! indices used for the SUM control 
    459          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    460             lsp_area = .FALSE. 
    461          ELSE                                             ! print control done over a specific  area 
    462             lsp_area = .TRUE. 
    463             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    464                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    465                nictls = 1 
    466             ENDIF 
    467             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    468                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    469                nictle = jpiglo 
    470             ENDIF 
    471             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    472                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    473                njctls = 1 
    474             ENDIF 
    475             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    476                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    477                njctle = jpjglo 
    478             ENDIF 
    479          ENDIF 
    480       ENDIF 
    481427      ! 
    482428      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P2Z/p2zbio.F90

    r12377 r13176  
    1919   ! 
    2020   USE lbclnk          !  
    21    USE prtctl_trc      ! Print control for debbuging 
     21   USE prtctl          ! Print control for debbuging 
    2222   USE iom             ! 
    2323    
    … …  
    366366      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    367367         WRITE(charout, FMT="('bio')") 
    368          CALL prt_ctl_trc_info(charout) 
    369          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     368         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     369         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    370370      ENDIF 
    371371      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P2Z/p2zexp.F90

    r12738 r13176  
    1717   USE p2zsed 
    1818   USE lbclnk 
    19    USE prtctl_trc      ! Print control for debbuging 
     19   USE prtctl          ! Print control for debbuging 
    2020   USE trd_oce 
    2121   USE trdtrc 
    … …  
    139139      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    140140         WRITE(charout, FMT="('exp')") 
    141          CALL prt_ctl_trc_info(charout) 
    142          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     141         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     142         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    143143      ENDIF 
    144144      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P2Z/p2zopt.F90

    r12377 r13176  
    1818   USE trc 
    1919   USE sms_pisces 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    124124      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    125125         WRITE(charout, FMT="('opt')") 
    126          CALL prt_ctl_trc_info( charout ) 
    127          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
     126         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     127         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    128128      ENDIF 
    129129      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P2Z/p2zsed.F90

    r12377 r13176  
    1818   USE lbclnk          ! 
    1919   USE iom             ! 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    108108      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    109109         WRITE(charout, FMT="('sed')") 
    110          CALL prt_ctl_trc_info(charout) 
    111          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     110         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     111         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    112112      ENDIF 
    113113      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zagg.F90

    r12377 r13176  
    1717   USE trc             !  passive tracers common variables  
    1818   USE sms_pisces      !  PISCES Source Minus Sink variables 
    19    USE prtctl_trc      !  print control for debugging 
     19   USE prtctl          !  print control for debugging 
    2020 
    2121   IMPLICIT NONE 
    … …  
    170170      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    171171         WRITE(charout, FMT="('agg')") 
    172          CALL prt_ctl_trc_info(charout) 
    173          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     172         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     173         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    174174      ENDIF 
    175175      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zbio.F90

    r12377 r13176  
    3030   USE p4zfechem 
    3131   USE p4zligand       !  Prognostic ligand model 
    32    USE prtctl_trc      !  print control for debugging 
     32   USE prtctl          !  print control for debugging 
    3333   USE iom             !  I/O manager 
    3434   
    … …  
    107107      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    108108         WRITE(charout, FMT="('bio ')") 
    109          CALL prt_ctl_trc_info(charout) 
    110          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     109         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     110         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    111111      ENDIF 
    112112      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zfechem.F90

    r12377 r13176  
    1616   USE p4zche          ! chemical model 
    1717   USE p4zbc           ! Boundary conditions from sediments 
    18    USE prtctl_trc      ! print control for debugging 
     18   USE prtctl          ! print control for debugging 
    1919   USE iom             ! I/O manager 
    2020 
    … …  
    221221      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    222222         WRITE(charout, FMT="('fechem')") 
    223          CALL prt_ctl_trc_info(charout) 
    224          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     223         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     224         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    225225      ENDIF 
    226226      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zflx.F90

    r12377 r13176  
    1919   USE sms_pisces     !  PISCES Source Minus Sink variables 
    2020   USE p4zche         !  Chemical model 
    21    USE prtctl_trc     !  print control for debugging 
     21   USE prtctl         !  print control for debugging 
    2222   USE iom            !  I/O manager 
    2323   USE fldread        !  read input fields 
    … …  
    177177      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    178178         WRITE(charout, FMT="('flx ')") 
    179          CALL prt_ctl_trc_info(charout) 
    180          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     179         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     180         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    181181      ENDIF 
    182182 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zligand.F90

    r12377 r13176  
    1212   USE trc             ! passive tracers common variables  
    1313   USE sms_pisces      ! PISCES Source Minus Sink variables 
    14    USE prtctl_trc      ! print control for debugging 
     14   USE prtctl          ! print control for debugging 
    1515   USE iom             !  I/O manager 
    1616 
    … …  
    8989      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    9090         WRITE(charout, FMT="('ligand1')") 
    91          CALL prt_ctl_trc_info(charout) 
    92          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     91         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     92         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    9393      ENDIF 
    9494      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zlys.F90

    r12377 r13176  
    2020   USE sms_pisces      !  PISCES Source Minus Sink variables 
    2121   USE p4zche          !  Chemical model 
    22    USE prtctl_trc      !  print control for debugging 
     22   USE prtctl          !  print control for debugging 
    2323   USE iom             !  I/O manager 
    2424 
    … …  
    130130      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    131131        WRITE(charout, FMT="('lys ')") 
    132         CALL prt_ctl_trc_info(charout) 
    133         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     132        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     133        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    134134      ENDIF 
    135135      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zmeso.F90

    r12939 r13176  
    1515   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1616   USE p4zprod         ! production 
    17    USE prtctl_trc      ! print control for debugging 
     17   USE prtctl          ! print control for debugging 
    1818   USE iom             ! I/O manager 
    1919 
    … …  
    246246      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    247247        WRITE(charout, FMT="('meso')") 
    248         CALL prt_ctl_trc_info(charout) 
    249         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     248        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     249        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    250250      ENDIF 
    251251      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zmicro.F90

    r12939 r13176  
    1717   USE p4zprod         ! production 
    1818   USE iom             ! I/O manager 
    19    USE prtctl_trc      ! print control for debugging 
     19   USE prtctl          ! print control for debugging 
    2020 
    2121   IMPLICIT NONE 
    … …  
    202202      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    203203         WRITE(charout, FMT="('micro')") 
    204          CALL prt_ctl_trc_info(charout) 
    205          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     204         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     205         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    206206      ENDIF 
    207207      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zmort.F90

    r12377 r13176  
    1515   USE p4zprod         ! Primary productivity  
    1616   USE p4zlim          ! Phytoplankton limitation terms 
    17    USE prtctl_trc      ! print control for debugging 
     17   USE prtctl          ! print control for debugging 
    1818 
    1919   IMPLICIT NONE 
    … …  
    120120       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    121121         WRITE(charout, FMT="('nano')") 
    122          CALL prt_ctl_trc_info(charout) 
    123          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     122         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     123         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    124124       ENDIF 
    125125      ! 
    … …  
    192192      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    193193         WRITE(charout, FMT="('diat')") 
    194          CALL prt_ctl_trc_info(charout) 
    195          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     194         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     195         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    196196      ENDIF 
    197197      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zopt.F90

    r12377 r13176  
    1616   USE iom            ! I/O manager 
    1717   USE fldread        !  time interpolation 
    18    USE prtctl_trc     !  print control for debugging 
     18   USE prtctl         !  print control for debugging 
    1919 
    2020   IMPLICIT NONE 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zpoc.F90

    r12377 r13176  
    1515   USE trc             !  passive tracers common variables  
    1616   USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE prtctl_trc      !  print control for debugging 
     17   USE prtctl          !  print control for debugging 
    1818   USE iom             !  I/O manager 
    1919 
    … …  
    241241     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    242242        WRITE(charout, FMT="('poc1')") 
    243         CALL prt_ctl_trc_info(charout) 
    244         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     243        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     244        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    245245     ENDIF 
    246246 
    … …  
    433433      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    434434         WRITE(charout, FMT="('poc2')") 
    435          CALL prt_ctl_trc_info(charout) 
    436          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     435         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     436         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    437437      ENDIF 
    438438      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zprod.F90

    r12377 r13176  
    1616   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1717   USE p4zlim          ! Co-limitations of differents nutrients 
    18    USE prtctl_trc      ! print control for debugging 
     18   USE prtctl          ! print control for debugging 
    1919   USE iom             ! I/O manager 
    2020 
    … …  
    330330     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    331331         WRITE(charout, FMT="('prod')") 
    332          CALL prt_ctl_trc_info(charout) 
    333          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     332         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     333         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    334334     ENDIF 
    335335      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zrem.F90

    r12377 r13176  
    1818   USE p4zprod         !  Growth rate of the 2 phyto groups 
    1919   USE p4zlim 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121   USE iom             !  I/O manager 
    2222 
    … …  
    195195       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    196196         WRITE(charout, FMT="('rem1')") 
    197          CALL prt_ctl_trc_info(charout) 
    198          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     197         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     198         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    199199       ENDIF 
    200200 
    … …  
    217217       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    218218         WRITE(charout, FMT="('rem2')") 
    219          CALL prt_ctl_trc_info(charout) 
    220          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     219         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     220         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    221221       ENDIF 
    222222 
    … …  
    248248      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    249249         WRITE(charout, FMT="('rem3')") 
    250          CALL prt_ctl_trc_info(charout) 
    251          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     250         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     251         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    252252       ENDIF 
    253253 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zsed.F90

    r12377 r13176  
    1818   USE sed             !  Sediment module 
    1919   USE iom             !  I/O manager 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    314314      IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging) 
    315315         WRITE(charout, fmt="('sed ')") 
    316          CALL prt_ctl_trc_info(charout) 
    317          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     316         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     317         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    318318      ENDIF 
    319319      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zsink.F90

    r12377 r13176  
    1717   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1818   USE trcsink         !  General routine to compute sedimentation 
    19    USE prtctl_trc      !  print control for debugging 
     19   USE prtctl          !  print control for debugging 
    2020   USE iom             !  I/O manager 
    2121   USE lib_mpp 
    … …  
    143143      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    144144         WRITE(charout, FMT="('sink')") 
    145          CALL prt_ctl_trc_info(charout) 
    146          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     145         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     146         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    147147      ENDIF 
    148148      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zsms.F90

    r13124 r13176  
    2525   USE trdtrc          ! TOP trends variables 
    2626   USE sedmodel        ! Sediment model 
    27    USE prtctl_trc      ! print control for debugging 
     27   USE prtctl          ! print control for debugging 
    2828 
    2929   IMPLICIT NONE 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zmeso.F90

    r12377 r13176  
    1515   USE trc             !  passive tracers common variables  
    1616   USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE prtctl_trc      !  print control for debugging 
     17   USE prtctl          !  print control for debugging 
    1818   USE iom             !  I/O manager 
    1919 
    … …  
    359359      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    360360        WRITE(charout, FMT="('meso')") 
    361         CALL prt_ctl_trc_info(charout) 
    362         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     361        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     362        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    363363      ENDIF 
    364364      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zmicro.F90

    r12377 r13176  
    1818   USE p5zlim          !  Phytoplankton limitation terms 
    1919   USE iom             !  I/O manager 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    306306      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    307307         WRITE(charout, FMT="('micro')") 
    308          CALL prt_ctl_trc_info(charout) 
    309          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     308         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     309         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    310310      ENDIF 
    311311      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zmort.F90

    r12377 r13176  
    1616   USE p4zlim 
    1717   USE p5zlim          !  Phytoplankton limitation terms 
    18    USE prtctl_trc      !  print control for debugging 
     18   USE prtctl          !  print control for debugging 
    1919 
    2020   IMPLICIT NONE 
    … …  
    121121       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    122122         WRITE(charout, FMT="('nano')") 
    123          CALL prt_ctl_trc_info(charout) 
    124          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     123         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     124         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    125125       ENDIF 
    126126      ! 
    … …  
    179179       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    180180         WRITE(charout, FMT="('pico')") 
    181          CALL prt_ctl_trc_info(charout) 
    182          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     181         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     182         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    183183       ENDIF 
    184184      ! 
    … …  
    254254      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    255255         WRITE(charout, FMT="('diat')") 
    256          CALL prt_ctl_trc_info(charout) 
    257          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     256         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     257         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    258258      ENDIF 
    259259      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zprod.F90

    r12377 r13176  
    1818   USE p4zlim 
    1919   USE p5zlim          !  Co-limitations of differents nutrients 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121   USE iom             !  I/O manager 
    2222 
    … …  
    460460      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    461461         WRITE(charout, FMT="('prod')") 
    462          CALL prt_ctl_trc_info(charout) 
    463          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     462         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     463         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    464464      ENDIF 
    465465      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/SED/trcdmp_sed.F90

    r12377 r13176  
    2121   USE trc             ! ocean passive tracers variables 
    2222   USE trcdta 
    23    USE prtctl_trc      ! Print control for debbuging 
     23   USE prtctl          ! Print control for debbuging 
    2424   USE iom 
    2525 
    … …  
    107107      IF( sn_cfctl%l_prttrc ) THEN 
    108108         WRITE(charout, FMT="('dmp ')") 
    109          CALL prt_ctl_trc_info(charout) 
    110          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     109         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     110         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    111111      ENDIF 
    112112      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcadv.F90

    r12810 r13176  
    2929   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    3030   ! 
    31    USE prtctl_trc     ! control print 
     31   USE prtctl         ! control print 
    3232   USE timing         ! Timing 
    3333 
    … …  
    137137      IF( sn_cfctl%l_prttrc ) THEN        !== print mean trends (used for debugging) 
    138138         WRITE(charout, FMT="('adv ')") 
    139          CALL prt_ctl_trc_info(charout) 
    140          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     139         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     140         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    141141      END IF 
    142142      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcatf.F90

    r12489 r13176  
    3939   ! 
    4040   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    41    USE prtctl_trc      ! Print control for debbuging 
     41   USE prtctl          ! Print control for debbuging 
    4242 
    4343   IMPLICIT NONE 
    … …  
    174174      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    175175         WRITE(charout, FMT="('nxt')") 
    176          CALL prt_ctl_trc_info(charout) 
    177          CALL prt_ctl_trc(tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm) 
     176         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     177         CALL prt_ctl(tab4d_1=ptr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm) 
    178178      ENDIF 
    179179      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcbbl.F90

    r12377 r13176  
    2525   USE trdtra         ! tracer trends 
    2626   USE trabbl         ! bottom boundary layer  
    27    USE prtctl_trc     ! Print control for debbuging 
     27   USE prtctl         ! Print control for debbuging 
    2828 
    2929   PUBLIC   trc_bbl   !  routine called by trctrp.F90 
    … …  
    7070         CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    7171         IF( sn_cfctl%l_prttrc )   THEN 
    72             WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout) 
    73             CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     72            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     73            CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    7474         ENDIF 
    7575         ! 
    … …  
    8181         CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    8282         IF( sn_cfctl%l_prttrc )   THEN 
    83             WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout) 
    84             CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     83            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     84            CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    8585         ENDIF 
    8686         ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcdmp.F90

    r13138 r13176  
    2424   ! 
    2525   USE iom 
    26    USE prtctl_trc      ! Print control for debbuging 
     26   USE prtctl          ! Print control for debbuging 
    2727 
    2828   IMPLICIT NONE 
    … …  
    148148      IF( sn_cfctl%l_prttrc ) THEN 
    149149         WRITE(charout, FMT="('dmp ')") 
    150          CALL prt_ctl_trc_info(charout) 
    151          CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     150         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     151         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    152152      ENDIF 
    153153      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcldf.F90

    r12377 r13176  
    2525   USE trdtra         ! trends manager: tracers 
    2626   ! 
    27    USE prtctl_trc     ! Print control 
     27   USE prtctl         ! Print control 
    2828 
    2929   IMPLICIT NONE 
    … …  
    114114      IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 
    115115         WRITE(charout, FMT="('ldf ')") 
    116          CALL prt_ctl_trc_info(charout) 
    117          CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     116         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     117         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    118118      ENDIF 
    119119      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcrad.F90

    r12489 r13176  
    1919   USE trd_oce 
    2020   USE trdtra 
    21    USE prtctl_trc          ! Print control for debbuging 
     21   USE prtctl              ! Print control for debbuging 
    2222   USE lib_fortran 
    2323 
    … …  
    7272      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    7373         WRITE(charout, FMT="('rad')") 
    74          CALL prt_ctl_trc_info( charout ) 
    75          CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Kbb), mask=tmask, clinfo=ctrcnm ) 
     74         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     75         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Kbb), mask1=tmask, clinfo=ctrcnm ) 
    7676      ENDIF 
    7777      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcsbc.F90

    r12738 r13176  
    1818   USE oce_trc         ! ocean dynamics and active tracers variables 
    1919   USE trc             ! ocean  passive tracers variables 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121   USE iom 
    2222   USE trd_oce 
    … …  
    186186      ! 
    187187      IF( sn_cfctl%l_prttrc )   THEN 
    188          WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
    189                                            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     188         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     189                                           CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    190190      ENDIF 
    191191      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trczdf.F90

    r12489 r13176  
    2222!!gm 
    2323   USE trdtra        ! trends manager: tracers  
    24    USE prtctl_trc    ! Print control 
     24   USE prtctl        ! Print control 
    2525 
    2626   IMPLICIT NONE 
    … …  
    6969      IF( sn_cfctl%l_prttrc )   THEN 
    7070         WRITE(charout, FMT="('zdf ')") 
    71          CALL prt_ctl_trc_info(charout) 
    72          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kaa), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     71         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     72         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kaa), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    7373      END IF 
    7474      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/trcini.F90

    r12960 r13176  
    2020   USE trcnam          ! Namelist read 
    2121   USE daymod          ! calendar manager 
    22    USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
     22   USE prtctl          ! Print control passive tracers (prt_ctl_init routine) 
    2323   USE trcrst 
    2424   USE lib_mpp         ! distribued memory computing library 
    … …  
    126126      IF(lwp) WRITE(numout,*) 
    127127      IF(sn_cfctl%l_prttrc) THEN            ! print mean trends (used for debugging) 
    128          CALL prt_ctl_trc_init 
     128         CALL prt_ctl_init( 'top', jptra ) 
    129129         WRITE(charout, FMT="('ini ')") 
    130          CALL prt_ctl_trc_info( charout ) 
    131          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
     130         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     131         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    132132         DO jn = 1, jptra 
    133133            zzmsk(:,:,:,jn) = tmask(:,:,:) 
    134134            WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn 
    135135         END DO 
    136          CALL prt_ctl_trc( tab4d=zzmsk, mask=tmask, clinfo=clseb ) 
     136         CALL prt_ctl( tab4d_1=zzmsk, mask1=tmask, clinfo=clseb ) 
    137137      ENDIF 
    1381389000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/trcsms.F90

    r12377 r13176  
    2020   USE trcsms_age         ! AGE 
    2121   USE trcsms_my_trc      ! MY_TRC  tracers 
    22    USE prtctl_trc         ! Print control for debbuging 
     22   USE prtctl             ! Print control for debbuging 
    2323 
    2424   IMPLICIT NONE 
    … …  
    5858      IF(sn_cfctl%l_prttrc) THEN                       ! print mean trends (used for debugging) 
    5959         WRITE(charout, FMT="('sms ')") 
    60          CALL prt_ctl_trc_info( charout ) 
    61          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
     60         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     61         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    6262      ENDIF 
    6363      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/trcstp.F90

    r12939 r13176  
    2222   USE sms_pisces,  ONLY : ln_check_mass 
    2323   ! 
    24    USE prtctl_trc     ! Print control for debbuging 
     24   USE prtctl         ! Print control for debbuging 
    2525   USE iom            ! 
    2626   USE in_out_manager ! 
    … …  
    9191      IF(sn_cfctl%l_prttrc) THEN 
    9292         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    93          CALL prt_ctl_trc_info(charout) 
     93         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    9494      ENDIF 
    9595      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca025_like

    r13174 r13176  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca12_like

    r13174 r13176  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca1_like

    r13174 r13176  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/ISOMIP+/MY_SRC/sbcfwb.F90

    r12939 r13176  
    211211            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    212212            ! 
    213             IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     213            IF( lwp ) THEN                   ! control print 
    214214               IF( z_fwf < 0._wp ) THEN 
    215215                  WRITE(numout,*)'   z_fwf < 0' 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r13015 r13176  
    3030   USE step_c1d       ! Time stepping loop for the 1D configuration 
    3131   ! 
     32   USE prtctl         ! Print control 
    3233   USE in_out_manager ! I/O manager 
    3334   USE lib_mpp        ! distributed memory computing 
    … …  
    131132      INTEGER ::   ios, ilocal_comm   ! local integers 
    132133      !! 
    133       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    134          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    135          &             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 
    136136      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    137137      !!---------------------------------------------------------------------- 
    … …  
    306306         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    307307         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    308          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    309          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    310          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    311          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    312          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    313          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    314          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    315308         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    316309         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    317310      ENDIF 
    318311      ! 
    319       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    320       nictls    = nn_ictls 
    321       nictle    = nn_ictle 
    322       njctls    = nn_jctls 
    323       njctle    = nn_jctle 
    324       isplt     = nn_isplt 
    325       jsplt     = nn_jsplt 
    326  
     312      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    327313      IF(lwp) THEN                  ! control print 
    328314         WRITE(numout,*) 
    … …  
    335321         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    336322      ENDIF 
    337       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    338       ! 
    339       !                             ! Parameter control 
    340       ! 
    341       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    342          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    343             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    344          ELSE 
    345             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    346                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    347                   &           ' - the print control will be done over the whole domain' ) 
    348             ENDIF 
    349             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    350          ENDIF 
    351          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    352          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    353          ! 
    354          !                              ! indices used for the SUM control 
    355          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    356             lsp_area = .FALSE. 
    357          ELSE                                             ! print control done over a specific  area 
    358             lsp_area = .TRUE. 
    359             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    360                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    361                nictls = 1 
    362             ENDIF 
    363             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    364                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    365                nictle = jpiglo 
    366             ENDIF 
    367             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    368                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    369                njctls = 1 
    370             ENDIF 
    371             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    372                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    373                njctle = jpjglo 
    374             ENDIF 
    375          ENDIF 
    376       ENDIF 
    377323      ! 
    378324      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 
Note: See TracChangeset for help on using the changeset viewer.