- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/IOM/prtctl.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/IOM/prtctl.F90
r12377 r13540 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 :: nlditl , nldjtl ! first, last indoor index for each i-domain 21 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nleitl , nlejtl ! 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 :: nlcitl , nlcjtl ! 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, nlditl(jn) ) 137 nictle = MIN(jpi, nleitl(jn) ) 138 njctls = MAX( 1, nldjtl(jn) ) 139 njctle = MIN(jpj, nlejtl(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, nleitl(jn) - 1) 144 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(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 + nlditl(jn) ) 147 nictle = MIN(jpi, nimpptl(jn) - 1 + nleitl(jn) ) 148 njctls = MAX( 1, njmpptl(jn) - 1 + nldjtl(jn) ) 149 njctle = MIN(jpj, njmpptl(jn) - 1 + nlejtl(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) + nleitl(jn) - 2) 154 IF( ibonjtl(jn) == 1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nlejtl(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( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) , & 280 & nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) , & 281 & nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) , & 282 & nlcjtl(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 nlditl(1:jpnij) = nldit(:) 298 nleitl(1:jpnij) = nleit(:) 299 nldjtl(1:jpnij) = nldjt(:) 300 nlejtl(1:jpnij) = nlejt(:) 301 ! 302 nimpptl(1:jpnij) = nimppt(:) 303 njmpptl(1:jpnij) = njmppt(:) 304 ! 305 nlcitl(1:jpnij) = nlcit(:) 306 nlcjtl(1:jpnij) = nlcjt(:) 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) + nlditl(jn) - 1 338 nictle = nimpptl(jn) + nleitl(jn) - 1 339 njctls = njmpptl(jn) + nldjtl(jn) - 1 340 njctle = njmpptl(jn) + nlejtl(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)' nlej = ', nlejtl(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)' nldi = ', nlditl(jn), ' nlei = ', nleitl(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), ' nldj = ', nldjtl(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 !! nlcil : first dimension 395 !! nlcjl : 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, nlcil, & ! temporary logical unit 411 nlcjl , nbondil, nbondjl, & 412 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 413 414 INTEGER, DIMENSION(jpi,jpj) :: iimpptl, ijmpptl, ilcitl, ilcjtl ! 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 ilcitl() ilcjtl() 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 ilcitl(ji,jj) = ijpi 451 END DO 452 ilcitl(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 ilcitl(ji,jj) = ijpi 460 END DO 461 DO ji = irestil+1, isplt 462 ilcitl(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 ilcjtl(ji,jj) = ijpj 475 END DO 476 ilcjtl(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 ilcjtl(ji,jj) = ijpj 484 END DO 485 DO jj = irestjl+1, jsplt 486 ilcjtl(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 + ilcitl(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 ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 497 498 zjdom = nrecjl 499 DO jj = 1, jsplt 500 zjdom = zjdom + ilcjtl(1,jj) - nrecjl 501 END DO 502 IF(lwp) WRITE(numout,*)' sum ilcitl(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) + ilcitl(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)+ilcjtl(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 nlcitl (jn) = ilcitl (ii,ij) 537 nlcil = nlcitl (jn) 538 nlcjtl (jn) = ilcjtl (ii,ij) 539 nlcjl = nlcjtl (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 nldil = 1 + nn_hls 553 nleil = nlcil - nn_hls 554 IF( nbondil == -1 .OR. nbondil == 2 ) nldil = 1 555 IF( nbondil == 1 .OR. nbondil == 2 ) nleil = nlcil 556 nldjl = 1 + nn_hls 557 nlejl = nlcjl - nn_hls 558 IF( nbondjl == -1 .OR. nbondjl == 2 ) nldjl = 1 559 IF( nbondjl == 1 .OR. nbondjl == 2 ) nlejl = nlcjl 560 nlditl(jn) = nldil 561 nleitl(jn) = nleil 562 nldjtl(jn) = nldjl 563 nlejtl(jn) = nlejl 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 nlcil nlcjl nldil nldjl nleil nlejl nimpptl njmpptl ibonitl ibonjtl' 570 ! 571 DO jn = 1, ijsplt 572 WRITE(inum,'(i5,6i6,4i8)') jn-1,nlcitl(jn), nlcjtl(jn), & 573 & nlditl(jn), nldjtl(jn), & 574 & nleitl(jn), nlejtl(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 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
