Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r2528 r2715 1 1 MODULE prtctl 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE prtctl *** 4 !! Ocean system : print all SUM trends for each processor domain 5 !!============================================================================== 4 !! Ocean system : print all SUM trends for each processor domain 5 !!====================================================================== 6 !! History : 9.0 ! 05-07 (C. Talandier) original code 7 !!---------------------------------------------------------------------- 6 8 USE dom_oce ! ocean space and time domain variables 7 9 USE in_out_manager ! I/O manager … … 11 13 PRIVATE 12 14 13 !! * Module declaration 14 INTEGER, DIMENSION(:), ALLOCATABLE :: numid 15 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: & !: 16 nlditl , nldjtl , & !: first, last indoor index for each i-domain 17 nleitl , nlejtl , & !: first, last indoor index for each j-domain 18 nimpptl, njmpptl, & !: i-, j-indexes for each processor 19 nlcitl , nlcjtl , & !: dimensions of every subdomain 20 ibonitl, ibonjtl 21 22 REAL(wp), DIMENSION(:), ALLOCATABLE :: & !: 23 t_ctll , s_ctll , & !: previous trend values 24 u_ctll , v_ctll 25 26 INTEGER :: ktime !: time step 27 28 !! * Routine accessibility 15 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: numid 16 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nlditl , nldjtl ! first, last indoor index for each i-domain 17 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nleitl , nlejtl ! first, last indoor index for each j-domain 18 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nimpptl, njmpptl ! i-, j-indexes for each processor 19 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: nlcitl , nlcjtl ! dimensions of every subdomain 20 INTEGER , DIMENSION(:), ALLOCATABLE, SAVE :: ibonitl, ibonjtl ! 21 22 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: t_ctll , s_ctll ! previous tracer trend values 23 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: u_ctll , v_ctll ! previous velocity trend values 24 25 INTEGER :: ktime ! time step 26 29 27 PUBLIC prt_ctl ! called by all subroutines 30 28 PUBLIC prt_ctl_info ! called by all subroutines 31 29 PUBLIC prt_ctl_init ! called by opa.F90 30 32 31 !!---------------------------------------------------------------------- 33 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 34 33 !! $Id$ 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 35 !!---------------------------------------------------------------------- 37 38 39 36 CONTAINS 40 37 41 SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, mask2, clinfo2, ovlap, kdim, clinfo3) 38 SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2, & 39 & mask2, clinfo2, ovlap, kdim, clinfo3 ) 42 40 !!---------------------------------------------------------------------- 43 41 !! *** ROUTINE prt_ctl *** … … 74 72 !! kdim : k- direction for 3D arrays 75 73 !! clinfo3 : additional information 76 !! 77 !! History : 78 !! 9.0 ! 05-07 (C. Talandier) original code 79 !!---------------------------------------------------------------------- 80 !! * Arguments 81 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1 82 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 83 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask1 84 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo1 85 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_2 86 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_2 87 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2 88 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo2 89 INTEGER , INTENT(in), OPTIONAL :: ovlap 90 INTEGER , INTENT(in), OPTIONAL :: kdim 91 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo3 92 93 !! * Local declarations 94 INTEGER :: overlap, jn, sind, eind, kdir,j_id 74 !!---------------------------------------------------------------------- 75 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 76 USE wrk_nemo, ONLY: ztab2d_1 => wrk_2d_30 , ztab2d_2 => wrk_2d_31 77 USE wrk_nemo, ONLY: zmask1 => wrk_3d_11 , zmask2 => wrk_3d_12 78 USE wrk_nemo, ONLY: ztab3d_1 => wrk_3d_13 , ztab3d_2 => wrk_3d_14 79 ! 80 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1 81 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 82 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask1 83 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo1 84 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_2 85 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_2 86 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask2 87 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo2 88 INTEGER , INTENT(in), OPTIONAL :: ovlap 89 INTEGER , INTENT(in), OPTIONAL :: kdim 90 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo3 91 ! 95 92 CHARACTER (len=15) :: cl2 93 INTEGER :: overlap, jn, sind, eind, kdir,j_id 96 94 REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 97 REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2 98 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 99 !!---------------------------------------------------------------------- 95 !!---------------------------------------------------------------------- 96 97 IF( wrk_in_use(2, 30,31) .OR. wrk_in_use(3, 11,12,13,14) ) THEN 98 CALL ctl_stop('prt_ctl : requested workspace arrays unavailable') ; RETURN 99 ENDIF 100 100 101 101 ! Arrays, scalars initialization … … 115 115 116 116 ! Control of optional arguments 117 IF( PRESENT(clinfo2) ) cl2 = clinfo2 118 IF( PRESENT(ovlap) ) overlap = ovlap 119 IF( PRESENT(kdim) ) kdir = kdim 120 IF( PRESENT(tab2d_1) ) ztab2d_1(:,:) = tab2d_1(:,:) 121 IF( PRESENT(tab2d_2) ) ztab2d_2(:,:) = tab2d_2(:,:) 122 IF( PRESENT(tab3d_1) ) ztab3d_1(:,:,1:kdir)= tab3d_1(:,:,:) 123 IF( PRESENT(tab3d_2) ) ztab3d_2(:,:,1:kdir)= tab3d_2(:,:,:) 124 IF( PRESENT(mask1) ) zmask1 (:,:,:)= mask1 (:,:,:) 125 IF( PRESENT(mask2) ) zmask2 (:,:,:)= mask2 (:,:,:) 126 127 IF( lk_mpp ) THEN 128 ! processor number 117 IF( PRESENT(clinfo2) ) cl2 = clinfo2 118 IF( PRESENT(ovlap) ) overlap = ovlap 119 IF( PRESENT(kdim) ) kdir = kdim 120 IF( PRESENT(tab2d_1) ) ztab2d_1(:,:) = tab2d_1(:,:) 121 IF( PRESENT(tab2d_2) ) ztab2d_2(:,:) = tab2d_2(:,:) 122 IF( PRESENT(tab3d_1) ) ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,:) 123 IF( PRESENT(tab3d_2) ) ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,:) 124 IF( PRESENT(mask1) ) zmask1 (:,:,:) = mask1 (:,:,:) 125 IF( PRESENT(mask2) ) zmask2 (:,:,:) = mask2 (:,:,:) 126 127 IF( lk_mpp ) THEN ! processor number 129 128 sind = narea 130 129 eind = narea 131 ELSE 132 ! processors total number 130 ELSE ! processors total number 133 131 sind = 1 134 132 eind = ijsplt … … 206 204 ENDDO 207 205 206 IF( wrk_not_released(2, 30,31) .OR. & 207 wrk_not_released(3, 11,12,13,14) ) CALL ctl_stop('prt_ctl: failed to release workspace arrays') 208 ! 208 209 END SUBROUTINE prt_ctl 209 210 … … 220 221 !! clinfo2 : information about the ivar2 221 222 !! ivar2 : value to print 222 !! 223 !! History : 224 !! 9.0 ! 05-07 (C. Talandier) original code 225 !!---------------------------------------------------------------------- 226 !! * Arguments 227 CHARACTER (len=*), INTENT(in) :: clinfo1 223 !!---------------------------------------------------------------------- 224 CHARACTER (len=*), INTENT(in) :: clinfo1 228 225 INTEGER , INTENT(in), OPTIONAL :: ivar1 229 226 CHARACTER (len=*), INTENT(in), OPTIONAL :: clinfo2 230 227 INTEGER , INTENT(in), OPTIONAL :: ivar2 231 228 INTEGER , INTENT(in), OPTIONAL :: itime 232 233 !! * Local declarations 229 ! 234 230 INTEGER :: jn, sind, eind, iltime, j_id 235 231 !!---------------------------------------------------------------------- 236 232 237 IF( lk_mpp ) THEN 238 ! processor number 233 IF( lk_mpp ) THEN ! processor number 239 234 sind = narea 240 235 eind = narea 241 ELSE 242 ! total number of processors 236 ELSE ! total number of processors 243 237 sind = 1 244 238 eind = ijsplt … … 257 251 ! Loop over each sub-domain, i.e. number of processors ijsplt 258 252 DO jn = sind, eind 259 260 ! Set logical unit 261 j_id = numid(jn - narea + 1) 262 253 ! 254 j_id = numid(jn - narea + 1) ! Set logical unit 255 ! 263 256 IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) ) THEN 264 257 WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2 … … 272 265 WRITE(j_id,*)clinfo1 273 266 ENDIF 274 275 END DO276 277 278 END SUBROUTINE prt_ctl_info 267 ! 268 END DO 269 ! 270 END SUBROUTINE prt_ctl_info 271 279 272 280 273 SUBROUTINE prt_ctl_init … … 283 276 !! 284 277 !! ** Purpose : open ASCII files & compute indices 285 !! 286 !! History : 287 !! 9.0 ! 05-07 (C. Talandier) original code 288 !!---------------------------------------------------------------------- 289 !! * Local declarations 278 !!---------------------------------------------------------------------- 290 279 INTEGER :: jn, sind, eind, j_id 291 280 CHARACTER (len=28) :: clfile_out … … 295 284 296 285 ! Allocate arrays 297 ALLOCATE(nlditl (ijsplt)) 298 ALLOCATE(nldjtl (ijsplt)) 299 ALLOCATE(nleitl (ijsplt)) 300 ALLOCATE(nlejtl (ijsplt)) 301 ALLOCATE(nimpptl(ijsplt)) 302 ALLOCATE(njmpptl(ijsplt)) 303 ALLOCATE(nlcitl (ijsplt)) 304 ALLOCATE(nlcjtl (ijsplt)) 305 ALLOCATE(t_ctll (ijsplt)) 306 ALLOCATE(s_ctll (ijsplt)) 307 ALLOCATE(u_ctll (ijsplt)) 308 ALLOCATE(v_ctll (ijsplt)) 309 ALLOCATE(ibonitl(ijsplt)) 310 ALLOCATE(ibonjtl(ijsplt)) 286 ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) , & 287 & nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) , & 288 & nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) , & 289 & nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt) ) 311 290 312 291 ! Initialization 313 t_ctll(:) =0.e0314 s_ctll(:) =0.e0315 u_ctll(:) =0.e0316 v_ctll(:) =0.e0292 t_ctll(:) = 0.e0 293 s_ctll(:) = 0.e0 294 u_ctll(:) = 0.e0 295 v_ctll(:) = 0.e0 317 296 ktime = 1 318 297 … … 345 324 ENDIF 346 325 347 ALLOCATE( numid(eind-sind+1))326 ALLOCATE( numid(eind-sind+1) ) 348 327 349 328 DO jn = sind, eind … … 392 371 9003 FORMAT(a20,i4.4,a17,i4.4) 393 372 9004 FORMAT(a11,i4.4,a26,i4.4,a14) 394 END DO395 373 END DO 374 ! 396 375 END SUBROUTINE prt_ctl_init 397 376 … … 434 413 !! 8.5 ! 02-08 (G. Madec) F90 : free form 435 414 !!---------------------------------------------------------------------- 436 !! * Local variables437 415 INTEGER :: ji, jj, jn ! dummy loop indices 438 416 INTEGER :: & … … 443 421 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 444 422 445 INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 446 iimpptl, ijmpptl, ilcitl, ilcjtl ! temporary workspace 423 INTEGER, DIMENSION(:,:), ALLOCATABLE :: iimpptl, ijmpptl, ilcitl, ilcjtl ! workspace 447 424 REAL(wp) :: zidom, zjdom ! temporary scalars 448 425 !!---------------------------------------------------------------------- … … 564 541 nlejtl(jn) = nlejl 565 542 END DO 566 567 DEALLOCATE(iimpptl) 568 DEALLOCATE(ijmpptl) 569 DEALLOCATE(ilcitl) 570 DEALLOCATE(ilcjtl) 571 543 ! 544 DEALLOCATE( iimpptl, ijmpptl, ilcitl, ilcjtl ) 545 ! 572 546 END SUBROUTINE sub_dom 573 547 548 !!====================================================================== 574 549 END MODULE prtctl
Note: See TracChangeset
for help on using the changeset viewer.
