Changeset 13176
- Timestamp:
- 2020-06-29T18:02:13+02:00 (5 years ago)
- 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 1412 1412 sn_cfctl%procincr = 1 ! Increment for optional subsetting of areas [default:1] 1413 1413 sn_cfctl%ptimincr = 1 ! Timestep increment for writing time step progress info 1414 nn_print = 0 ! level of print (0 no extra print)1415 1414 nn_ictls = 0 ! start i indice of control sum (use to compare mono versus 1416 1415 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 565 565 IF(sn_cfctl%l_prtctl) THEN 566 566 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 : ' ) 569 569 ENDIF 570 570 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/ICE/icectl.F90
r12939 r13176 702 702 DO jl = 1, jpl 703 703 CALL prt_ctl_info(' ') 704 CALL prt_ctl_info(' - Category : ', ivar 1=jl)704 CALL prt_ctl_info(' - Category : ', ivar=jl) 705 705 CALL prt_ctl_info(' ~~~~~~~~~~') 706 706 CALL prt_ctl(tab2d_1=h_i (:,:,jl) , clinfo1= ' h_i : ') … … 719 719 720 720 DO jk = 1, nlay_i 721 CALL prt_ctl_info(' - Layer : ', ivar 1=jk)721 CALL prt_ctl_info(' - Layer : ', ivar=jk) 722 722 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i : ') 723 723 END DO -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/daymod.F90
r12489 r13176 279 279 IF(sn_cfctl%l_prtctl) THEN 280 280 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 ) 282 282 ENDIF 283 283 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domain.F90
r13065 r13176 254 254 WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk 255 255 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 279 257 ! 280 258 END SUBROUTINE dom_glo -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domzgr.F90
r13138 r13176 182 182 !!gm end bug 183 183 ! 184 IF( nprint == 1 .AND.lwp ) THEN184 IF( lwp ) THEN 185 185 WRITE(numout,*) ' MIN val k_top ', MINVAL( k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) ) 186 186 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 118 118 LOGICAL :: ln_timing !: run control for timing 119 119 LOGICAL :: ln_diacfl !: flag whether to create CFL diagnostics 120 INTEGER :: nn_print !: level of print (0 no print)121 120 INTEGER :: nn_ictls !: Start i indice for the SUM control 122 121 INTEGER :: nn_ictle !: End i indice for the SUM control … … 125 124 INTEGER :: nn_isplt !: number of processors following i 126 125 INTEGER :: nn_jsplt !: number of processors following j 127 !128 INTEGER :: nprint, nictls, nictle, njctls, njctle, isplt, jsplt !: OLD namelist names129 130 INTEGER :: ijsplt = 1 !: nb of local domain = nb of processors131 126 132 127 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/IOM/prtctl.F90
r12807 r13176 8 8 !!---------------------------------------------------------------------- 9 9 USE dom_oce ! ocean space and time domain variables 10 #if defined key_nemocice_decomp11 USE ice_domain_size, only: nx_global, ny_global12 #endif13 10 USE in_out_manager ! I/O manager 11 USE mppini ! distributed memory computing 14 12 USE lib_mpp ! distributed memory computing 15 13 16 14 IMPLICIT NONE 17 15 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 ! 31 24 PUBLIC prt_ctl ! called by all subroutines 32 25 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 35 27 36 28 !!---------------------------------------------------------------------- … … 41 33 CONTAINS 42 34 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 ) 45 37 !!---------------------------------------------------------------------- 46 38 !! *** ROUTINE prt_ctl *** … … 68 60 !! tab2d_1 : first 2D array 69 61 !! tab3d_1 : first 3D array 62 !! tab4d_1 : first 4D array 70 63 !! mask1 : mask (3D) to apply to the tab[23]d_1 array 71 64 !! clinfo1 : information about the tab[23]d_1 array … … 77 70 !! clinfo3 : additional information 78 71 !!---------------------------------------------------------------------- 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 92 89 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 ! 97 92 ! 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 110 97 111 98 ! 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) 128 103 129 104 ! 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 145 188 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 463 192 END DO 464 193 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 ! 488 229 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 ! 494 424 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 583 428 584 429 !!====================================================================== -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90
r13174 r13176 32 32 PRIVATE 33 33 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 36 39 INTEGER :: numbot = -1 ! 'bottom_level' local logical unit 37 40 INTEGER :: numbdy = -1 ! 'bdy_msk' local logical unit … … 76 79 jpnj = 1 77 80 jpnij = jpni*jpnj 78 nimpp = 1 ! 81 nn_hls = 1 82 nimpp = 1 79 83 njmpp = 1 80 84 nbondi = 2 … … 137 141 INTEGER :: ji, jj, jn, jproc, jarea ! dummy loop indices 138 142 INTEGER :: inijmin 139 INTEGER :: i2add140 143 INTEGER :: inum ! local logical unit 141 INTEGER :: idir, ifreq , icont! local integers144 INTEGER :: idir, ifreq ! local integers 142 145 INTEGER :: ii, il1, ili, imil ! - - 143 146 INTEGER :: ij, il2, ilj, ijm1 ! - - … … 186 189 ENDIF 187 190 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 188 192 ENDIF 189 193 ! … … 225 229 CALL bestpartition( mppsize, inbi, inbj, icnt2 ) ! best mpi decomposition for mppsize mpi processes 226 230 ! 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 ) 228 232 ! 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 ) 230 234 icnt1 = jpni*jpnj - mppsize ! number of land subdomains that should be removed to use mppsize mpi processes 231 235 IF(lwp) THEN … … 258 262 ! look for land mpi subdomains... 259 263 ALLOCATE( llisoce(jpni,jpnj) ) 260 CALL is_ocean( jpni, jpnj,llisoce )264 CALL mpp_is_ocean( llisoce ) 261 265 inijmin = COUNT( llisoce ) ! number of oce subdomains 262 266 … … 316 320 9003 FORMAT (a, i5) 317 321 318 IF( numbot /= -1 ) CALL iom_close( numbot )319 IF( numbdy /= -1 ) CALL iom_close( numbdy )320 321 322 ALLOCATE( nfimpp(jpni ) , nfproc(jpni ) , nfjpi(jpni ) , & 322 323 & nimppt(jpnij) , ibonit(jpnij) , jpiall(jpnij) , jpjall(jpnij) , & … … 346 347 ! ----------------------------------- 347 348 ! 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) 349 353 nfimpp(:) = iimppt(:,jpnj) 350 354 nfjpi (:) = ijpi(:,jpnj) … … 357 361 WRITE(numout,*) ' jpni = ', jpni 358 362 WRITE(numout,*) ' jpnj = ', jpnj 363 WRITE(numout,*) ' jpnij = ', jpnij 359 364 WRITE(numout,*) 360 365 WRITE(numout,*) ' sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo … … 431 436 ! ---------------------------- 432 437 ! 433 ! specify which subdomains are oce subdomains; other are land subdomains434 ipproc(:,:) = -1435 icont = -1436 DO jarea = 1, jpni*jpnj437 iarea0 = jarea - 1438 ii = 1 + MOD(iarea0,jpni)439 ij = 1 + iarea0/jpni440 IF( llisoce(ii,ij) ) THEN441 icont = icont + 1442 ipproc(ii,ij) = icont443 iin(icont+1) = ii444 ijn(icont+1) = ij445 ENDIF446 END DO447 ! if needed add some land subdomains to reach jpnij active subdomains448 i2add = jpnij - inijmin449 DO jarea = 1, jpni*jpnj450 iarea0 = jarea - 1451 ii = 1 + MOD(iarea0,jpni)452 ij = 1 + iarea0/jpni453 IF( .NOT. llisoce(ii,ij) .AND. i2add > 0 ) THEN454 icont = icont + 1455 ipproc(ii,ij) = icont456 iin(icont+1) = ii457 ijn(icont+1) = ij458 i2add = i2add - 1459 ENDIF460 END DO461 nfproc(:) = ipproc(:,jpnj)462 463 438 ! neighbour treatment: change ibondi, ibondj if next to a land zone 464 439 DO jarea = 1, jpni*jpnj … … 655 630 WRITE(numout,*) ' nimpp = ', nimpp 656 631 WRITE(numout,*) ' njmpp = ', njmpp 657 WRITE(numout,*) ' nn_hls = ', nn_hls658 632 ENDIF 659 633 … … 700 674 701 675 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 *** 705 679 !! 706 680 !! ** Purpose : Lay out the global domain over processors. … … 757 731 klci(iresti+1:knbi ,:) = kimax-1 758 732 IF( MINVAL(klci) < 2*i2hls ) THEN 759 WRITE(ctmp1,*) ' basic_decomposition: minimum value of jpi must be >= ', 2*i2hls733 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 760 734 WRITE(ctmp2,*) ' We have ', MINVAL(klci) 761 735 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) … … 775 749 klcj(:,1:irestj) = kjmax 776 750 IF( MINVAL(klcj) < 2*i2hls ) THEN 777 WRITE(ctmp1,*) ' basic_decomposition: minimum value of jpj must be >= ', 2*i2hls751 WRITE(ctmp1,*) ' mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 778 752 WRITE(ctmp2,*) ' We have ', MINVAL(klcj) 779 753 CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) … … 802 776 ENDIF 803 777 804 END SUBROUTINE basic_decomposition778 END SUBROUTINE mpp_basesplit 805 779 806 780 … … 909 883 iszij1(:) = iszi1(:) * iszj1(:) 910 884 911 ! if ther ris no land and no print885 ! if there is no land and no print 912 886 IF( .NOT. llist .AND. numbot == -1 .AND. numbdy == -1 ) THEN 913 887 ! get the smaller partition which gives the smallest subdomain size … … 957 931 ji = isz0 ! initialization with the largest value 958 932 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) 960 934 inbijold = COUNT(llisoce) 961 935 DEALLOCATE( llisoce ) 962 936 DO ji =isz0-1,1,-1 963 937 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) 965 939 inbij = COUNT(llisoce) 966 940 DEALLOCATE( llisoce ) … … 988 962 ii = ii -1 989 963 ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 990 CALL is_ocean( inbi0(ii), inbj0(ii),llisoce ) ! must be done by all core964 CALL mpp_is_ocean( llisoce ) ! must be done by all core 991 965 inbij = COUNT(llisoce) 992 966 DEALLOCATE( llisoce ) … … 1052 1026 1053 1027 1054 SUBROUTINE is_ocean( knbi, knbj,ldisoce )1055 !!---------------------------------------------------------------------- 1056 !! *** ROUTINE mpp_i nit_nboce***1057 !! 1058 !! ** Purpose : Check for a mpi domain decomposition knbi x knbj which1028 SUBROUTINE mpp_is_ocean( ldisoce ) 1029 !!---------------------------------------------------------------------- 1030 !! *** ROUTINE mpp_is_ocean *** 1031 !! 1032 !! ** Purpose : Check for a mpi domain decomposition inbi x inbj which 1059 1033 !! subdomains, including 1 halo (even if nn_hls>1), contain 1060 1034 !! at least 1 ocean point. … … 1065 1039 !! a subdomain with a closed boundary. 1066 1040 !! 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 ! 1074 1045 INTEGER :: idiv, iimax, ijmax, iarea 1075 INTEGER :: in x, iny, inry, isty1046 INTEGER :: inbi, inbj, inx, iny, inry, isty 1076 1047 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 1078 1050 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: iimppt, ijpi 1079 1051 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: ijmppt, ijpj 1052 LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: lloce ! lloce(i,j) = .true. if the point (i,j) is ocean 1080 1053 !!---------------------------------------------------------------------- 1081 1054 ! do nothing if there is no land-sea mask … … 1084 1057 RETURN 1085 1058 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) ) 1092 1070 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) 1095 1073 ! 1096 1074 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 11075 IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= inbj ) THEN ! beware idiv can be = to 1 1098 1076 ! 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 ) 1101 1079 ! 1102 1080 inx = Ni0glo + 2 ; iny = ijpj(1,iarea) + 2 ! strip size + 1 halo on each direction (even if nn_hls>1) 1103 1081 ALLOCATE( lloce(inx, iny) ) ! allocate the strip 1104 inry = iny - COUNT( (/ iarea == 1, iarea == knbj /) ) ! number of point to read in y-direction1082 inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) ) ! number of point to read in y-direction 1105 1083 isty = 1 + COUNT( (/ iarea == 1 /) ) ! read from the first or the second line? 1106 1084 CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) ) ! read the strip … … 1113 1091 ENDIF 1114 1092 ENDIF 1115 IF( iarea == knbj ) THEN ! the last line was not read1093 IF( iarea == inbj ) THEN ! the last line was not read 1116 1094 IF( jperio == 2 .OR. jperio == 7 ) THEN ! north-south periodocity 1117 1095 CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) ) ! read the first line -> last line of lloce … … 1127 1105 ENDIF 1128 1106 ! 1129 DO ji = 1, knbi1107 DO ji = 1, inbi 1130 1108 inboce(ji,iarea) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)+1,:) ) ! lloce as 2 points more than Ni0glo 1131 1109 END DO … … 1137 1115 END DO 1138 1116 1139 inboce_1d = RESHAPE(inboce, (/ knbi*knbj /))1117 inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 1140 1118 CALL mpp_sum( 'mppini', inboce_1d ) 1141 inboce = RESHAPE(inboce_1d, (/ knbi, knbj/))1119 inboce = RESHAPE(inboce_1d, (/inbi, inbj/)) 1142 1120 ldisoce(:,:) = inboce(:,:) /= 0 1143 ! 1144 END SUBROUTINE is_ocean 1121 DEALLOCATE(inboce, inboce_1d) 1122 ! 1123 END SUBROUTINE mpp_is_ocean 1145 1124 1146 1125 … … 1155 1134 !! ** Method : read stipe of size (Ni0glo,...) 1156 1135 !!---------------------------------------------------------------------- 1157 INTEGER , INTENT(in ) :: kjstr ! starting j position of the reading1158 INTEGER , INTENT(in ) :: kjcnt ! number of lines to read1159 LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT( out) :: ldoce ! ldoce(i,j) = .true. if the point (i,j) is ocean1136 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 1160 1139 ! 1161 1140 INTEGER :: inumsave ! local logical unit … … 1180 1159 ! 1181 1160 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 1182 1214 1183 1215 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcfwb.F90
r12489 r13176 186 186 erp(:,:) = erp(:,:) + zerp_cor(:,:) 187 187 ! 188 IF( nprint == 1 .AND.lwp ) THEN ! control print188 IF( lwp ) THEN ! control print 189 189 IF( z_fwf < 0._wp ) THEN 190 190 WRITE(numout,*)' z_fwf < 0' -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/USR/usrdef_hgr.F90
r13065 r13176 109 109 CALL ctl_warn( ' GYRE used as Benchmark: e1=e2=106km, no need to adjust rn_Dt, ahm,aht ' ) 110 110 ENDIF 111 IF( nprint==1 .AND.lwp ) THEN111 IF( lwp ) THEN 112 112 WRITE(numout,*) 'ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 113 113 WRITE(numout,*) 'ze1deg', ze1deg, 'zlam0', zlam0, 'zphi0', zphi0 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/nemogcm.F90
r13065 r13176 84 84 #endif 85 85 ! 86 USE prtctl ! Print control 86 87 USE in_out_manager ! I/O manager 87 88 USE lib_mpp ! distributed memory computing … … 272 273 INTEGER :: ios, ilocal_comm ! local integers 273 274 !! 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 277 277 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 278 278 !!---------------------------------------------------------------------- … … 534 534 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 535 535 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 536 WRITE(numout,*) ' level of print nn_print = ', nn_print537 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls538 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle539 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls540 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle541 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt542 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt543 536 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 544 537 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 545 538 ENDIF 546 539 ! 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 555 541 IF(lwp) THEN ! control print 556 542 WRITE(numout,*) … … 563 549 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 564 550 ENDIF 565 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file566 !567 ! ! Parameter control568 !569 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints570 IF( lk_mpp .AND. jpnij > 1 ) THEN571 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain572 ELSE573 IF( isplt == 1 .AND. jsplt == 1 ) THEN574 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &575 & ' - the print control will be done over the whole domain' )576 ENDIF577 ijsplt = isplt * jsplt ! total number of processors ijsplt578 ENDIF579 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'580 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt581 !582 ! ! indices used for the SUM control583 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area584 lsp_area = .FALSE.585 ELSE ! print control done over a specific area586 lsp_area = .TRUE.587 IF( nictls < 1 .OR. nictls > jpiglo ) THEN588 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )589 nictls = 1590 ENDIF591 IF( nictle < 1 .OR. nictle > jpiglo ) THEN592 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )593 nictle = jpiglo594 ENDIF595 IF( njctls < 1 .OR. njctls > jpjglo ) THEN596 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )597 njctls = 1598 ENDIF599 IF( njctle < 1 .OR. njctle > jpjglo ) THEN600 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )601 njctle = jpjglo602 ENDIF603 ENDIF604 ENDIF605 551 ! 606 552 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 158 158 zchl = zrgb(1,jc) 159 159 irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 ) 160 IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' irgb = ', irgb161 160 IF( irgb /= jc ) THEN 162 161 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 179 179 INTEGER :: ios, ilocal_comm ! local integers 180 180 !! 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 184 183 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 185 184 !!---------------------------------------------------------------------- … … 374 373 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 375 374 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 376 WRITE(numout,*) ' level of print nn_print = ', nn_print377 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls378 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle379 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls380 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle381 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt382 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt383 375 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 384 376 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 385 377 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 395 380 IF(lwp) THEN ! control print 396 381 WRITE(numout,*) … … 402 387 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 403 388 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 404 ENDIF405 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file406 !407 ! ! Parameter control408 !409 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints410 IF( lk_mpp .AND. jpnij > 1 ) THEN411 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain412 ELSE413 IF( isplt == 1 .AND. jsplt == 1 ) THEN414 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &415 & ' - the print control will be done over the whole domain' )416 ENDIF417 ijsplt = isplt * jsplt ! total number of processors ijsplt418 ENDIF419 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'420 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt421 !422 ! ! indices used for the SUM control423 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area424 lsp_area = .FALSE.425 ELSE ! print control done over a specific area426 lsp_area = .TRUE.427 IF( nictls < 1 .OR. nictls > jpiglo ) THEN428 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )429 nictls = 1430 ENDIF431 IF( nictle < 1 .OR. nictle > jpiglo ) THEN432 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )433 nictle = jpiglo434 ENDIF435 IF( njctls < 1 .OR. njctls > jpjglo ) THEN436 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )437 njctls = 1438 ENDIF439 IF( njctle < 1 .OR. njctle > jpjglo ) THEN440 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )441 njctle = jpjglo442 ENDIF443 ENDIF444 389 ENDIF 445 390 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAO/nemogcm.F90
r12960 r13176 29 29 USE sao_intp 30 30 ! 31 USE prtctl ! Print control 31 32 USE in_out_manager ! I/O manager 32 33 USE lib_mpp ! distributed memory computing … … 93 94 INTEGER :: ios, ilocal_comm ! local integer 94 95 ! 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 98 98 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 99 99 !!---------------------------------------------------------------------- … … 270 270 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 271 271 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 272 WRITE(numout,*) ' level of print nn_print = ', nn_print273 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls274 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle275 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls276 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle277 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt278 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt279 272 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 280 273 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 281 274 ENDIF 282 275 ! 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 291 277 IF(lwp) THEN ! control print 292 278 WRITE(numout,*) … … 298 284 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 299 285 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 300 ENDIF301 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file302 !303 ! ! Parameter control304 !305 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints306 IF( lk_mpp .AND. jpnij > 1 ) THEN307 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain308 ELSE309 IF( isplt == 1 .AND. jsplt == 1 ) THEN310 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &311 & ' - the print control will be done over the whole domain' )312 ENDIF313 ijsplt = isplt * jsplt ! total number of processors ijsplt314 ENDIF315 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'316 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt317 !318 ! ! indices used for the SUM control319 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area320 lsp_area = .FALSE.321 ELSE ! print control done over a specific area322 lsp_area = .TRUE.323 IF( nictls < 1 .OR. nictls > jpiglo ) THEN324 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )325 nictls = 1326 ENDIF327 IF( nictle < 1 .OR. nictle > jpiglo ) THEN328 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )329 nictle = jpiglo330 ENDIF331 IF( njctls < 1 .OR. njctls > jpjglo ) THEN332 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )333 njctls = 1334 ENDIF335 IF( njctle < 1 .OR. njctle > jpjglo ) THEN336 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )337 njctle = jpjglo338 ENDIF339 ENDIF340 286 ENDIF 341 287 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAS/nemogcm.F90
r13015 r13176 35 35 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 36 36 ! 37 USE prtctl ! Print control 37 38 USE in_out_manager ! I/O manager 38 39 USE lib_mpp ! distributed memory computing … … 202 203 INTEGER :: ios, ilocal_comm ! local integers 203 204 !! 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 207 207 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 208 208 !!---------------------------------------------------------------------- … … 410 410 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 411 411 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 412 WRITE(numout,*) ' level of print nn_print = ', nn_print413 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls414 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle415 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls416 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle417 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt418 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt419 412 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 420 413 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 421 414 ENDIF 422 415 ! 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 431 417 IF(lwp) THEN ! control print 432 418 WRITE(numout,*) … … 439 425 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 440 426 ENDIF 441 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file442 !443 ! ! Parameter control444 !445 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints446 IF( lk_mpp .AND. jpnij > 1 ) THEN447 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain448 ELSE449 IF( isplt == 1 .AND. jsplt == 1 ) THEN450 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &451 & ' - the print control will be done over the whole domain' )452 ENDIF453 ijsplt = isplt * jsplt ! total number of processors ijsplt454 ENDIF455 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'456 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt457 !458 ! ! indices used for the SUM control459 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area460 lsp_area = .FALSE.461 ELSE ! print control done over a specific area462 lsp_area = .TRUE.463 IF( nictls < 1 .OR. nictls > jpiglo ) THEN464 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )465 nictls = 1466 ENDIF467 IF( nictle < 1 .OR. nictle > jpiglo ) THEN468 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )469 nictle = jpiglo470 ENDIF471 IF( njctls < 1 .OR. njctls > jpjglo ) THEN472 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )473 njctls = 1474 ENDIF475 IF( njctle < 1 .OR. njctle > jpjglo ) THEN476 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )477 njctle = jpjglo478 ENDIF479 ENDIF480 ENDIF481 427 ! 482 428 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 19 19 ! 20 20 USE lbclnk ! 21 USE prtctl _trc! Print control for debbuging21 USE prtctl ! Print control for debbuging 22 22 USE iom ! 23 23 … … 366 366 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 367 367 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) 370 370 ENDIF 371 371 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P2Z/p2zexp.F90
r12738 r13176 17 17 USE p2zsed 18 18 USE lbclnk 19 USE prtctl _trc! Print control for debbuging19 USE prtctl ! Print control for debbuging 20 20 USE trd_oce 21 21 USE trdtrc … … 139 139 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 140 140 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) 143 143 ENDIF 144 144 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P2Z/p2zopt.F90
r12377 r13176 18 18 USE trc 19 19 USE sms_pisces 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 22 22 IMPLICIT NONE … … 124 124 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 125 125 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 ) 128 128 ENDIF 129 129 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P2Z/p2zsed.F90
r12377 r13176 18 18 USE lbclnk ! 19 19 USE iom ! 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 22 22 IMPLICIT NONE … … 108 108 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 109 109 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) 112 112 ENDIF 113 113 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zagg.F90
r12377 r13176 17 17 USE trc ! passive tracers common variables 18 18 USE sms_pisces ! PISCES Source Minus Sink variables 19 USE prtctl _trc! print control for debugging19 USE prtctl ! print control for debugging 20 20 21 21 IMPLICIT NONE … … 170 170 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 171 171 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) 174 174 ENDIF 175 175 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zbio.F90
r12377 r13176 30 30 USE p4zfechem 31 31 USE p4zligand ! Prognostic ligand model 32 USE prtctl _trc! print control for debugging32 USE prtctl ! print control for debugging 33 33 USE iom ! I/O manager 34 34 … … 107 107 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 108 108 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) 111 111 ENDIF 112 112 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zfechem.F90
r12377 r13176 16 16 USE p4zche ! chemical model 17 17 USE p4zbc ! Boundary conditions from sediments 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 USE iom ! I/O manager 20 20 … … 221 221 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 222 222 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) 225 225 ENDIF 226 226 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zflx.F90
r12377 r13176 19 19 USE sms_pisces ! PISCES Source Minus Sink variables 20 20 USE p4zche ! Chemical model 21 USE prtctl _trc! print control for debugging21 USE prtctl ! print control for debugging 22 22 USE iom ! I/O manager 23 23 USE fldread ! read input fields … … 177 177 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 178 178 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) 181 181 ENDIF 182 182 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zligand.F90
r12377 r13176 12 12 USE trc ! passive tracers common variables 13 13 USE sms_pisces ! PISCES Source Minus Sink variables 14 USE prtctl _trc! print control for debugging14 USE prtctl ! print control for debugging 15 15 USE iom ! I/O manager 16 16 … … 89 89 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 90 90 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) 93 93 ENDIF 94 94 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zlys.F90
r12377 r13176 20 20 USE sms_pisces ! PISCES Source Minus Sink variables 21 21 USE p4zche ! Chemical model 22 USE prtctl _trc! print control for debugging22 USE prtctl ! print control for debugging 23 23 USE iom ! I/O manager 24 24 … … 130 130 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 131 131 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) 134 134 ENDIF 135 135 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zmeso.F90
r12939 r13176 15 15 USE sms_pisces ! PISCES Source Minus Sink variables 16 16 USE p4zprod ! production 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 USE iom ! I/O manager 19 19 … … 246 246 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 247 247 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) 250 250 ENDIF 251 251 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zmicro.F90
r12939 r13176 17 17 USE p4zprod ! production 18 18 USE iom ! I/O manager 19 USE prtctl _trc! print control for debugging19 USE prtctl ! print control for debugging 20 20 21 21 IMPLICIT NONE … … 202 202 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 203 203 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) 206 206 ENDIF 207 207 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zmort.F90
r12377 r13176 15 15 USE p4zprod ! Primary productivity 16 16 USE p4zlim ! Phytoplankton limitation terms 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 19 19 IMPLICIT NONE … … 120 120 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 121 121 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) 124 124 ENDIF 125 125 ! … … 192 192 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 193 193 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) 196 196 ENDIF 197 197 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zopt.F90
r12377 r13176 16 16 USE iom ! I/O manager 17 17 USE fldread ! time interpolation 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 20 20 IMPLICIT NONE -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zpoc.F90
r12377 r13176 15 15 USE trc ! passive tracers common variables 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 USE iom ! I/O manager 19 19 … … 241 241 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 242 242 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) 245 245 ENDIF 246 246 … … 433 433 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 434 434 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) 437 437 ENDIF 438 438 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zprod.F90
r12377 r13176 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 17 USE p4zlim ! Co-limitations of differents nutrients 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 USE iom ! I/O manager 20 20 … … 330 330 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 331 331 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) 334 334 ENDIF 335 335 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zrem.F90
r12377 r13176 18 18 USE p4zprod ! Growth rate of the 2 phyto groups 19 19 USE p4zlim 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 USE iom ! I/O manager 22 22 … … 195 195 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 196 196 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) 199 199 ENDIF 200 200 … … 217 217 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 218 218 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) 221 221 ENDIF 222 222 … … 248 248 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 249 249 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) 252 252 ENDIF 253 253 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zsed.F90
r12377 r13176 18 18 USE sed ! Sediment module 19 19 USE iom ! I/O manager 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 22 22 IMPLICIT NONE … … 314 314 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (USEd for debugging) 315 315 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) 318 318 ENDIF 319 319 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zsink.F90
r12377 r13176 17 17 USE sms_pisces ! PISCES Source Minus Sink variables 18 18 USE trcsink ! General routine to compute sedimentation 19 USE prtctl _trc! print control for debugging19 USE prtctl ! print control for debugging 20 20 USE iom ! I/O manager 21 21 USE lib_mpp … … 143 143 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 144 144 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) 147 147 ENDIF 148 148 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p4zsms.F90
r13124 r13176 25 25 USE trdtrc ! TOP trends variables 26 26 USE sedmodel ! Sediment model 27 USE prtctl _trc! print control for debugging27 USE prtctl ! print control for debugging 28 28 29 29 IMPLICIT NONE -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zmeso.F90
r12377 r13176 15 15 USE trc ! passive tracers common variables 16 16 USE sms_pisces ! PISCES Source Minus Sink variables 17 USE prtctl _trc! print control for debugging17 USE prtctl ! print control for debugging 18 18 USE iom ! I/O manager 19 19 … … 359 359 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 360 360 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) 363 363 ENDIF 364 364 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zmicro.F90
r12377 r13176 18 18 USE p5zlim ! Phytoplankton limitation terms 19 19 USE iom ! I/O manager 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 22 22 IMPLICIT NONE … … 306 306 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 307 307 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) 310 310 ENDIF 311 311 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zmort.F90
r12377 r13176 16 16 USE p4zlim 17 17 USE p5zlim ! Phytoplankton limitation terms 18 USE prtctl _trc! print control for debugging18 USE prtctl ! print control for debugging 19 19 20 20 IMPLICIT NONE … … 121 121 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 122 122 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) 125 125 ENDIF 126 126 ! … … 179 179 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 180 180 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) 183 183 ENDIF 184 184 ! … … 254 254 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 255 255 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) 258 258 ENDIF 259 259 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/P4Z/p5zprod.F90
r12377 r13176 18 18 USE p4zlim 19 19 USE p5zlim ! Co-limitations of differents nutrients 20 USE prtctl _trc! print control for debugging20 USE prtctl ! print control for debugging 21 21 USE iom ! I/O manager 22 22 … … 460 460 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 461 461 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) 464 464 ENDIF 465 465 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/PISCES/SED/trcdmp_sed.F90
r12377 r13176 21 21 USE trc ! ocean passive tracers variables 22 22 USE trcdta 23 USE prtctl _trc! Print control for debbuging23 USE prtctl ! Print control for debbuging 24 24 USE iom 25 25 … … 107 107 IF( sn_cfctl%l_prttrc ) THEN 108 108 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' ) 111 111 ENDIF 112 112 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcadv.F90
r12810 r13176 29 29 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 30 30 ! 31 USE prtctl _trc! control print31 USE prtctl ! control print 32 32 USE timing ! Timing 33 33 … … 137 137 IF( sn_cfctl%l_prttrc ) THEN !== print mean trends (used for debugging) 138 138 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' ) 141 141 END IF 142 142 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcatf.F90
r12489 r13176 39 39 ! 40 40 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 41 USE prtctl _trc! Print control for debbuging41 USE prtctl ! Print control for debbuging 42 42 43 43 IMPLICIT NONE … … 174 174 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 175 175 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) 178 178 ENDIF 179 179 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcbbl.F90
r12377 r13176 25 25 USE trdtra ! tracer trends 26 26 USE trabbl ! bottom boundary layer 27 USE prtctl _trc! Print control for debbuging27 USE prtctl ! Print control for debbuging 28 28 29 29 PUBLIC trc_bbl ! routine called by trctrp.F90 … … 70 70 CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 71 71 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' ) 74 74 ENDIF 75 75 ! … … 81 81 CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm ) 82 82 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' ) 85 85 ENDIF 86 86 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcdmp.F90
r13138 r13176 24 24 ! 25 25 USE iom 26 USE prtctl _trc! Print control for debbuging26 USE prtctl ! Print control for debbuging 27 27 28 28 IMPLICIT NONE … … 148 148 IF( sn_cfctl%l_prttrc ) THEN 149 149 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' ) 152 152 ENDIF 153 153 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcldf.F90
r12377 r13176 25 25 USE trdtra ! trends manager: tracers 26 26 ! 27 USE prtctl _trc! Print control27 USE prtctl ! Print control 28 28 29 29 IMPLICIT NONE … … 114 114 IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 115 115 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' ) 118 118 ENDIF 119 119 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcrad.F90
r12489 r13176 19 19 USE trd_oce 20 20 USE trdtra 21 USE prtctl _trc! Print control for debbuging21 USE prtctl ! Print control for debbuging 22 22 USE lib_fortran 23 23 … … 72 72 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 73 73 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 ) 76 76 ENDIF 77 77 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcsbc.F90
r12738 r13176 18 18 USE oce_trc ! ocean dynamics and active tracers variables 19 19 USE trc ! ocean passive tracers variables 20 USE prtctl _trc! Print control for debbuging20 USE prtctl ! Print control for debbuging 21 21 USE iom 22 22 USE trd_oce … … 186 186 ! 187 187 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' ) 190 190 ENDIF 191 191 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trczdf.F90
r12489 r13176 22 22 !!gm 23 23 USE trdtra ! trends manager: tracers 24 USE prtctl _trc! Print control24 USE prtctl ! Print control 25 25 26 26 IMPLICIT NONE … … 69 69 IF( sn_cfctl%l_prttrc ) THEN 70 70 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' ) 73 73 END IF 74 74 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/trcini.F90
r12960 r13176 20 20 USE trcnam ! Namelist read 21 21 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) 23 23 USE trcrst 24 24 USE lib_mpp ! distribued memory computing library … … 126 126 IF(lwp) WRITE(numout,*) 127 127 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 128 CALL prt_ctl_ trc_init128 CALL prt_ctl_init( 'top', jptra ) 129 129 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 ) 132 132 DO jn = 1, jptra 133 133 zzmsk(:,:,:,jn) = tmask(:,:,:) 134 134 WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn 135 135 END DO 136 CALL prt_ctl _trc( tab4d=zzmsk, mask=tmask, clinfo=clseb )136 CALL prt_ctl( tab4d_1=zzmsk, mask1=tmask, clinfo=clseb ) 137 137 ENDIF 138 138 9000 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 20 20 USE trcsms_age ! AGE 21 21 USE trcsms_my_trc ! MY_TRC tracers 22 USE prtctl _trc! Print control for debbuging22 USE prtctl ! Print control for debbuging 23 23 24 24 IMPLICIT NONE … … 58 58 IF(sn_cfctl%l_prttrc) THEN ! print mean trends (used for debugging) 59 59 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 ) 62 62 ENDIF 63 63 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/trcstp.F90
r12939 r13176 22 22 USE sms_pisces, ONLY : ln_check_mass 23 23 ! 24 USE prtctl _trc! Print control for debbuging24 USE prtctl ! Print control for debbuging 25 25 USE iom ! 26 26 USE in_out_manager ! … … 91 91 IF(sn_cfctl%l_prttrc) THEN 92 92 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' ) 94 94 ENDIF 95 95 ! -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca025_like
r13174 r13176 30 30 &namctl ! Control prints (default: OFF) 31 31 !----------------------------------------------------------------------- 32 nn_print = 0 ! level of print (0 no extra print)33 32 ln_timing = .false. ! timing by routine write out in timing.output file 34 33 / -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca12_like
r13174 r13176 30 30 &namctl ! Control prints (default: OFF) 31 31 !----------------------------------------------------------------------- 32 nn_print = 0 ! level of print (0 no extra print)33 32 ln_timing = .false. ! timing by routine write out in timing.output file 34 33 / -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/BENCH/EXPREF/namelist_cfg_orca1_like
r13174 r13176 30 30 &namctl ! Control prints (default: OFF) 31 31 !----------------------------------------------------------------------- 32 nn_print = 0 ! level of print (0 no extra print)33 32 ln_timing = .false. ! timing by routine write out in timing.output file 34 33 / -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/ISOMIP+/MY_SRC/sbcfwb.F90
r12939 r13176 211 211 erp(:,:) = erp(:,:) + zerp_cor(:,:) 212 212 ! 213 IF( nprint == 1 .AND.lwp ) THEN ! control print213 IF( lwp ) THEN ! control print 214 214 IF( z_fwf < 0._wp ) THEN 215 215 WRITE(numout,*)' z_fwf < 0' -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/tests/STATION_ASF/MY_SRC/nemogcm.F90
r13015 r13176 30 30 USE step_c1d ! Time stepping loop for the 1D configuration 31 31 ! 32 USE prtctl ! Print control 32 33 USE in_out_manager ! I/O manager 33 34 USE lib_mpp ! distributed memory computing … … 131 132 INTEGER :: ios, ilocal_comm ! local integers 132 133 !! 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 136 136 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 137 137 !!---------------------------------------------------------------------- … … 306 306 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 307 307 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 308 WRITE(numout,*) ' level of print nn_print = ', nn_print309 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls310 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle311 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls312 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle313 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt314 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt315 308 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 316 309 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 317 310 ENDIF 318 311 ! 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 327 313 IF(lwp) THEN ! control print 328 314 WRITE(numout,*) … … 335 321 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 336 322 ENDIF 337 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file338 !339 ! ! Parameter control340 !341 IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints342 IF( lk_mpp .AND. jpnij > 1 ) THEN343 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain344 ELSE345 IF( isplt == 1 .AND. jsplt == 1 ) THEN346 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &347 & ' - the print control will be done over the whole domain' )348 ENDIF349 ijsplt = isplt * jsplt ! total number of processors ijsplt350 ENDIF351 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'352 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt353 !354 ! ! indices used for the SUM control355 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area356 lsp_area = .FALSE.357 ELSE ! print control done over a specific area358 lsp_area = .TRUE.359 IF( nictls < 1 .OR. nictls > jpiglo ) THEN360 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )361 nictls = 1362 ENDIF363 IF( nictle < 1 .OR. nictle > jpiglo ) THEN364 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )365 nictle = jpiglo366 ENDIF367 IF( njctls < 1 .OR. njctls > jpjglo ) THEN368 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )369 njctls = 1370 ENDIF371 IF( njctle < 1 .OR. njctle > jpjglo ) THEN372 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )373 njctle = jpjglo374 ENDIF375 ENDIF376 ENDIF377 323 ! 378 324 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.