Changeset 13818
- Timestamp:
- 2020-11-18T18:56:00+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 2 edited
-
DOM/domain.F90 (modified) (3 diffs)
-
IOM/prtctl.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DOM/domain.F90
r13741 r13818 45 45 USE closea , ONLY : dom_clo ! closed seas 46 46 ! 47 USE prtctl ! Print control (prt_ctl_info routine) 47 48 USE in_out_manager ! I/O manager 48 49 USE iom ! I/O library … … 303 304 INTEGER :: jt ! dummy loop argument 304 305 INTEGER :: iitile, ijtile ! Local integers 306 CHARACTER (len=11) :: charout 305 307 !!---------------------------------------------------------------------- 306 308 IF( PRESENT(ktile) .AND. ln_tile ) THEN … … 310 312 ktei = ntei_a(ktile) 311 313 ktej = ntej_a(ktile) 314 315 IF(sn_cfctl%l_prtctl) THEN 316 WRITE(charout, FMT="('ntile =', I4)") ktile 317 CALL prt_ctl_info( charout ) 318 ENDIF 312 319 ELSE 313 320 ntile = 0 ! Initialise to full domain -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/IOM/prtctl.F90
r13286 r13818 8 8 !!---------------------------------------------------------------------- 9 9 USE dom_oce ! ocean space and time domain variables 10 USE domutl, ONLY : is_tile 10 11 USE in_out_manager ! I/O manager 11 12 USE mppini ! distributed memory computing … … 26 27 PUBLIC prt_ctl_init ! called by nemogcm.F90 and prt_ctl_trc_init 27 28 29 !! * Substitutions 30 # include "do_loop_substitute.h90" 28 31 !!---------------------------------------------------------------------- 29 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 35 38 SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2, & 36 39 & clinfo, clinfo1, clinfo2, clinfo3, kdim ) 40 !! 41 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1 42 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_1 43 REAL(wp), DIMENSION(:,:,:,:), INTENT(in), OPTIONAL :: tab4d_1 44 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_2 45 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: tab3d_2 46 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask1 47 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask2 48 CHARACTER(len=*), DIMENSION(:) , INTENT(in), OPTIONAL :: clinfo ! information about the tab3d array 49 CHARACTER(len=*) , INTENT(in), OPTIONAL :: clinfo1 50 CHARACTER(len=*) , INTENT(in), OPTIONAL :: clinfo2 51 CHARACTER(len=*) , INTENT(in), OPTIONAL :: clinfo3 52 INTEGER , INTENT(in), OPTIONAL :: kdim 53 ! 54 INTEGER :: itab2d_1, itab3d_1, itab4d_1, itab2d_2, itab3d_2 55 !! 56 IF( PRESENT(tab2d_1) ) THEN ; itab2d_1 = is_tile(tab2d_1) ; ELSE ; itab2d_1 = 0 ; ENDIF 57 IF( PRESENT(tab3d_1) ) THEN ; itab3d_1 = is_tile(tab3d_1) ; ELSE ; itab3d_1 = 0 ; ENDIF 58 IF( PRESENT(tab4d_1) ) THEN ; itab4d_1 = is_tile(tab4d_1) ; ELSE ; itab4d_1 = 0 ; ENDIF 59 IF( PRESENT(tab2d_2) ) THEN ; itab2d_2 = is_tile(tab2d_2) ; ELSE ; itab2d_2 = 0 ; ENDIF 60 IF( PRESENT(tab3d_2) ) THEN ; itab3d_2 = is_tile(tab3d_2) ; ELSE ; itab3d_2 = 0 ; ENDIF 61 62 CALL prt_ctl_t (tab2d_1, itab2d_1, tab3d_1, itab3d_1, tab4d_1, itab4d_1, tab2d_2, itab2d_2, tab3d_2, itab3d_2, & 63 & mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim ) 64 END SUBROUTINE prt_ctl 65 66 67 SUBROUTINE prt_ctl_t (tab2d_1, ktab2d_1, tab3d_1, ktab3d_1, tab4d_1, ktab4d_1, tab2d_2, ktab2d_2, tab3d_2, ktab3d_2, & 68 & mask1, mask2, clinfo, clinfo1, clinfo2, clinfo3, kdim ) 37 69 !!---------------------------------------------------------------------- 38 70 !! *** ROUTINE prt_ctl *** … … 70 102 !! clinfo3 : additional information 71 103 !!---------------------------------------------------------------------- 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 104 INTEGER , INTENT(in) :: ktab2d_1, ktab3d_1, ktab4d_1, ktab2d_2, ktab3d_2 105 REAL(wp), DIMENSION(A2D_T(ktab2d_1)) , INTENT(in), OPTIONAL :: tab2d_1 106 REAL(wp), DIMENSION(A2D_T(ktab3d_1),:) , INTENT(in), OPTIONAL :: tab3d_1 107 REAL(wp), DIMENSION(A2D_T(ktab4d_1),:,:), INTENT(in), OPTIONAL :: tab4d_1 108 REAL(wp), DIMENSION(A2D_T(ktab2d_2)) , INTENT(in), OPTIONAL :: tab2d_2 109 REAL(wp), DIMENSION(A2D_T(ktab3d_2),:) , INTENT(in), OPTIONAL :: tab3d_2 77 110 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask1 78 111 REAL(wp), DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask2 … … 106 139 107 140 ! define shoter names... 108 iis = nall_ictls(jl)109 iie = nall_ictle(jl)110 jjs = nall_jctls(jl)111 jje = nall_jctle(jl)141 iis = MAX( nall_ictls(jl), ntsi ) 142 iie = MIN( nall_ictle(jl), ntei ) 143 jjs = MAX( nall_jctls(jl), ntsj ) 144 jje = MIN( nall_jctle(jl), ntej ) 112 145 113 146 IF( PRESENT(clinfo) ) THEN ; inum = numprt_top(jl) … … 115 148 ENDIF 116 149 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) 150 ! Compute the sum control only where the tile domain and control print area overlap 151 IF( iie >= iis .AND. jje >= jjs ) THEN 152 DO jn = 1, itra 153 154 IF( PRESENT(clinfo3) ) THEN 155 IF ( clinfo3 == 'tra-ta' ) THEN 156 zvctl1 = t_ctl(jl) 157 ELSEIF( clinfo3 == 'tra' ) THEN 158 zvctl1 = t_ctl(jl) 159 zvctl2 = s_ctl(jl) 160 ELSEIF( clinfo3 == 'dyn' ) THEN 161 zvctl1 = u_ctl(jl) 162 zvctl2 = v_ctl(jl) 163 ELSE 164 zvctl1 = tra_ctl(jn,jl) 165 ENDIF 166 ENDIF 167 168 ! 2D arrays 169 IF( PRESENT(tab2d_1) ) THEN 170 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 171 ELSE ; zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) ) 172 ENDIF 173 ENDIF 174 IF( PRESENT(tab2d_2) ) THEN 175 IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 176 ELSE ; zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) ) 177 ENDIF 178 ENDIF 179 180 ! 3D arrays 181 IF( PRESENT(tab3d_1) ) THEN 182 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 183 ELSE ; zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) ) 184 ENDIF 185 ENDIF 186 IF( PRESENT(tab3d_2) ) THEN 187 IF( PRESENT(mask2) ) THEN ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 188 ELSE ; zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) ) 189 ENDIF 190 ENDIF 191 192 ! 4D arrays 193 IF( PRESENT(tab4d_1) ) THEN 194 IF( PRESENT(mask1) ) THEN ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 195 ELSE ; zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) ) 196 ENDIF 197 ENDIF 198 199 ! Print the result 200 IF( PRESENT(clinfo ) ) cl1 = clinfo(jn) 201 IF( PRESENT(clinfo3) ) THEN 202 ! 203 IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 204 WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 205 ELSE 206 WRITE(inum, "(3x,a,' : ',D23.16 )") cl1, zsum1 - zvctl1 207 ENDIF 208 ! 209 SELECT CASE( clinfo3 ) 210 CASE ( 'tra-ta' ) 211 t_ctl(jl) = zsum1 212 CASE ( 'tra' ) 213 t_ctl(jl) = zsum1 214 s_ctl(jl) = zsum2 215 CASE ( 'dyn' ) 216 u_ctl(jl) = zsum1 217 v_ctl(jl) = zsum2 218 CASE default 219 tra_ctl(jn,jl) = zsum1 220 END SELECT 221 ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 222 WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 128 223 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 188 ELSE 189 WRITE(inum, "(3x,a,' : ',D23.16 )") cl1, zsum1 190 ENDIF 191 192 END DO 224 WRITE(inum, "(3x,a,' : ',D23.16 )") cl1, zsum1 225 ENDIF 226 227 END DO 228 ENDIF 193 229 END DO 194 230 ! 195 END SUBROUTINE prt_ctl 231 END SUBROUTINE prt_ctl_t 196 232 197 233
Note: See TracChangeset
for help on using the changeset viewer.
