Changeset 12840 for NEMO/branches/2020/r12581_ticket2418/tests
- Timestamp:
- 2020-05-01T10:58:58+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12581_ticket2418/tests
- Files:
-
- 2 edited
-
CANAL/MY_SRC/stpctl.F90 (modified) (5 diffs)
-
STATION_ASF/MY_SRC/stpctl.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12581_ticket2418/tests/CANAL/MY_SRC/stpctl.F90
r12685 r12840 64 64 INTEGER :: ji ! dummy loop indices 65 65 INTEGER :: idtime, istatus 66 INTEGER, DIMENSION(3,4) :: iloc ! min/max loc indices 66 INTEGER , DIMENSION(9) :: iareasum, iareamin, iareamax 67 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 67 68 REAL(wp) :: zzz ! local real 68 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal , zarea69 REAL(wp), DIMENSION(9) :: zmax, zmaxlocal 69 70 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 70 71 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk … … 176 177 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 177 178 ! 179 iloc(:,:) = 0 178 180 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 179 181 ! first: close the netcdf file, so we can read it … … 182 184 CALL mpp_maxloc( 'stpctl', ABS(ssh(:,:, Kmm)), ssmask(:,: ), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 183 185 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:, Kmm)), umask(:,:,:), zzz, iloc(1:3,2) ) 184 CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,3) )185 CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,4) )186 !!$ CALL mpp_minloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,3) ) 187 !!$ CALL mpp_maxloc( 'stpctl', ts(:,:,:,jp_sal,Kmm) , tmask(:,:,:), zzz, iloc(1:3,4) ) 186 188 ! find which subdomain has the max. 187 zarea(:) = 0._wp189 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 188 190 DO ji = 1, 9 189 IF( zmaxlocal(ji) == zmax(ji) ) zarea(ji) = narea 191 IF( zmaxlocal(ji) == zmax(ji) ) THEN 192 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 193 ENDIF 190 194 END DO 191 CALL mpp_max( "stpctl", zarea ) ! max over the global domain 195 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 196 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 197 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 192 198 ELSE ! find local min and max locations: 193 199 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 194 200 iloc(1:2,1) = MAXLOC( ABS( ssh(:,:, Kmm)), mask = ssmask(:,: ) == 1._wp ) + (/ nimpp - 1, njmpp - 1 /) 195 201 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = umask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 196 iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)197 iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /)198 zarea(:) = narea! this is local information199 ENDIF 200 ! 201 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or S <= 0 or S >= 100or NaN encounter in the tests'202 WRITE(ctmp2,9100) kt, ' |ssh| max ', zmax(1), iloc(1,1), iloc(2,1), NINT(zarea(1))-1203 WRITE(ctmp3,9200) kt, ' |U| max ', zmax(2), iloc(1,2), iloc(2,2), iloc(3,2), NINT(zarea(2))-1204 WRITE(ctmp4,9200) kt, ' Sal min ', -zmax(3), iloc(1,3), iloc(2,3), iloc(3,3), NINT(zarea(3))-1 205 WRITE(ctmp5,9200) kt, ' Sal max ', zmax(4), iloc(1,4), iloc(2,4), iloc(3,4), NINT(zarea(4))-1 202 !!$ iloc(1:3,3) = MINLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 203 !!$ iloc(1:3,4) = MAXLOC( ts(:,:,:,jp_sal,Kmm) , mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 204 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 205 ENDIF 206 ! 207 WRITE(ctmp1,*) ' stp_ctl: |ssh| > 20 m or |U| > 10 m/s or NaN encounter in the tests' 208 CALL wrt_line( ctmp2, kt, '|ssh| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 209 CALL wrt_line( ctmp3, kt, '|U| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 210 !!$ CALL wrt_line( ctmp4, kt, 'Sal min', -zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 211 !!$ CALL wrt_line( ctmp5, kt, 'Sal max', zmax(4), iloc(:,4), iareasum(4), iareamin(4), iareamax(4) ) 206 212 IF( Agrif_Root() ) THEN 207 213 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' … … 213 219 ! 214 220 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 215 IF(lwp) CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5,' ', ctmp6 )216 ELSE ! only mpi subdomains with errors are here -> STOP now217 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5,' ', ctmp6 )221 IF(lwp) CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 222 ELSE ! only mpi subdomains with errors are here -> STOP now 223 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 218 224 ENDIF 219 225 ! … … 223 229 ENDIF 224 230 ! 225 9100 FORMAT(' kt ',i8,a,1pg11.4,' at i j ',2i6, 6x,' MPI rank',i6)226 9200 FORMAT(' kt ',i8,a,1pg11.4,' at i j k',2i6, i6,' MPI rank',i6)227 231 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 228 232 ! 229 233 END SUBROUTINE stp_ctl 234 235 236 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 237 !!---------------------------------------------------------------------- 238 !! *** ROUTINE wrt_line *** 239 !! 240 !! ** Purpose : write information line 241 !! 242 !!---------------------------------------------------------------------- 243 CHARACTER(len=*), INTENT( out) :: cdline 244 CHARACTER(len=*), INTENT(in ) :: cdprefix 245 REAL(wp), INTENT(in ) :: pval 246 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 247 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 248 ! 249 CHARACTER(len=9) :: clkt, clsum, clmin, clmax 250 CHARACTER(len=9) :: cli, clj, clk 251 CHARACTER(len=1) :: clfmt 252 CHARACTER(len=4) :: cl4 ! needed to be able to compile with Agrif, I don't know why 253 INTEGER :: ifmtk 254 !!---------------------------------------------------------------------- 255 WRITE(clkt , '(i9)') kt 256 257 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 258 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 259 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 260 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij-1,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 261 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 262 WRITE(clmax, cl4) kmax-1 263 ! 264 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 265 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 266 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 267 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 268 ! 269 IF( ksum == 1 ) THEN ; WRITE(cdline,9100) TRIM(clmin) 270 ELSE ; WRITE(cdline,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 271 ENDIF 272 IF(kloc(3) == 0) THEN 273 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 274 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 275 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(cdline) 276 ELSE 277 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 278 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 279 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 280 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(cdline) 281 ENDIF 282 ! 283 9100 FORMAT('MPI rank ', a) 284 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 285 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 286 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 287 ! 288 END SUBROUTINE wrt_line 289 230 290 231 291 !!====================================================================== -
NEMO/branches/2020/r12581_ticket2418/tests/STATION_ASF/MY_SRC/stpctl.F90
r12718 r12840 62 62 INTEGER :: ji ! dummy loop indices 63 63 INTEGER :: idtime, istatus 64 INTEGER, DIMENSION(2,3) :: iloc ! min/max loc indices 64 INTEGER , DIMENSION(4) :: iareasum, iareamin, iareamax 65 INTEGER , DIMENSION(3,3) :: iloc ! min/max loc indices 65 66 REAL(wp) :: zzz ! local real 66 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal , zarea67 REAL(wp), DIMENSION(4) :: zmax, zmaxlocal 67 68 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns 68 69 LOGICAL, DIMENSION(jpi,jpj) :: llmsk … … 138 139 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 139 140 ! 141 iloc(:,:) = 0 140 142 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 141 143 ! first: close the netcdf file, so we can read it … … 146 148 CALL mpp_minloc( 'stpctl',ABS( emp(:,:) ), tmask(:,:,1), zzz, iloc(1:2,3) ) 147 149 ! find which subdomain has the max. 148 zarea(:) = 0._wp150 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 149 151 DO ji = 1, 4 150 IF( zmaxlocal(ji) == zmax(ji) ) zarea(ji) = narea 152 IF( zmaxlocal(ji) == zmax(ji) ) THEN 153 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 154 ENDIF 151 155 END DO 152 CALL mpp_max( "stpctl", zarea ) ! max over the global domain 156 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 157 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 158 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 153 159 ELSE ! find local min and max locations: 154 160 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc … … 156 162 iloc(1:2,2) = MAXLOC( ABS( qns(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 157 163 iloc(1:2,3) = MINLOC( ABS( emp(:,:) ), mask = llmsk ) + (/ nimpp - 1, njmpp - 1/) 158 zarea(:) = narea! this is local information164 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 159 165 ENDIF 160 166 ! 161 167 WRITE(ctmp1,*) ' stp_ctl: |tau_mod| > 5 N/m2 or |qns| > 2000 W/m2 or |emp| > 1.E-3 or NaN encounter in the tests' 162 WRITE(ctmp2,9100) kt, ' |tau| max', zmax(1), iloc(1,1), iloc(2,1), NINT(zarea(1))-1163 WRITE(ctmp3,9100) kt, ' |qns| max', zmax(2), iloc(1,2), iloc(2,3), NINT(zarea(2))-1164 WRITE(ctmp4,9100) kt, ' emp max', zmax(3), iloc(1,2), iloc(2,3), NINT(zarea(3))-1168 CALL wrt_line( ctmp2, kt, '|tau| max', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 169 CALL wrt_line( ctmp3, kt, '|qns| max', zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 170 CALL wrt_line( ctmp4, kt, 'emp max', zmax(3), iloc(:,3), iareasum(3), iareamin(3), iareamax(3) ) 165 171 IF( Agrif_Root() ) THEN 166 172 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' … … 173 179 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 174 180 IF(lwp) CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 175 ELSE ! only mpi subdomains with errors are here -> STOP now181 ELSE ! only mpi subdomains with errors are here -> STOP now 176 182 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ctmp4, ctmp5, ' ', ctmp6 ) 177 183 ENDIF … … 182 188 ENDIF 183 189 ! 184 9100 FORMAT(' kt ',i8,a,1pg11.4,' at i j',2i6,' MPI rank',i6)185 190 9500 FORMAT(' it :', i8, ' tau_max: ', D23.16, ' |qns|_max: ', D23.16,' |emp|_max: ', D23.16) 186 191 ! 187 192 END SUBROUTINE stp_ctl 193 194 195 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 196 !!---------------------------------------------------------------------- 197 !! *** ROUTINE wrt_line *** 198 !! 199 !! ** Purpose : write information line 200 !! 201 !!---------------------------------------------------------------------- 202 CHARACTER(len=*), INTENT( out) :: cdline 203 CHARACTER(len=*), INTENT(in ) :: cdprefix 204 REAL(wp), INTENT(in ) :: pval 205 INTEGER, DIMENSION(3), INTENT(in ) :: kloc 206 INTEGER, INTENT(in ) :: kt, ksum, kmin, kmax 207 ! 208 CHARACTER(len=9) :: clkt, clsum, clmin, clmax 209 CHARACTER(len=9) :: cli, clj, clk 210 CHARACTER(len=1) :: clfmt 211 CHARACTER(len=4) :: cl4 ! needed to be able to compile with Agrif, I don't know why 212 INTEGER :: ifmtk 213 !!---------------------------------------------------------------------- 214 WRITE(clkt , '(i9)') kt 215 216 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij ,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 217 !!! WRITE(clsum, '(i'//clfmt//')') ksum ! this is creating a compilation error with AGRIF 218 cl4 = '(i'//clfmt//')' ; WRITE(clsum, cl4) ksum 219 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpnij-1,wp))) + 1 ! how many digits to we need to write ? (we decide max = 9) 220 cl4 = '(i'//clfmt//')' ; WRITE(clmin, cl4) kmin-1 221 WRITE(clmax, cl4) kmax-1 222 ! 223 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpiglo,wp))) + 1 ! how many digits to we need to write jpiglo? (we decide max = 9) 224 cl4 = '(i'//clfmt//')' ; WRITE(cli, cl4) kloc(1) ! this is ok with AGRIF 225 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpjglo,wp))) + 1 ! how many digits to we need to write jpjglo? (we decide max = 9) 226 cl4 = '(i'//clfmt//')' ; WRITE(clj, cl4) kloc(2) ! this is ok with AGRIF 227 ! 228 IF( ksum == 1 ) THEN ; WRITE(cdline,9100) TRIM(clmin) 229 ELSE ; WRITE(cdline,9200) TRIM(clsum), TRIM(clmin), TRIM(clmax) 230 ENDIF 231 IF(kloc(3) == 0) THEN 232 ifmtk = INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 233 clk = REPEAT(' ', ifmtk) ! create the equivalent in blank string 234 WRITE(cdline,9300) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), clk(1:ifmtk), TRIM(cdline) 235 ELSE 236 WRITE(clfmt, '(i1)') INT(LOG10(REAL(jpk,wp))) + 1 ! how many digits to we need to write jpk? (we decide max = 9) 237 !!! WRITE(clk, '(i'//clfmt//')') kloc(3) ! this is creating a compilation error with AGRIF 238 cl4 = '(i'//clfmt//')' ; WRITE(clk, cl4) kloc(3) ! this is ok with AGRIF 239 WRITE(cdline,9400) TRIM(ADJUSTL(clkt)), TRIM(ADJUSTL(cdprefix)), pval, TRIM(cli), TRIM(clj), TRIM(clk), TRIM(cdline) 240 ENDIF 241 ! 242 9100 FORMAT('MPI rank ', a) 243 9200 FORMAT('found in ', a, ' MPI tasks, spread out among ranks ', a, ' to ', a) 244 9300 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j ', a, ' ', a, ' ', a, ' ', a) 245 9400 FORMAT('kt ', a, ' ', a, ' ', 1pg11.4, ' at i j k ', a, ' ', a, ' ', a, ' ', a) 246 ! 247 END SUBROUTINE wrt_line 248 188 249 189 250 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
