Changeset 10358 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/CANAL/MY_SRC/stpctl.F90
- Timestamp:
- 2018-11-25T15:24:21+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/tests/CANAL/MY_SRC/stpctl.F90
r10314 r10358 32 32 PUBLIC stp_ctl ! routine called by step.F90 33 33 34 INTEGER :: idrun, idtime, idssh, idu, ids, istatus 34 INTEGER :: idrun, idtime, idssh, idu, ids1, ids2, istatus 35 LOGICAL :: lsomeoce 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 60 61 INTEGER, INTENT(inout) :: kindic ! error indicator 61 62 !! 62 INTEGER :: ji, jj, jk ! dummy loop indices 63 INTEGER :: iih, ijh ! local integers 64 INTEGER :: iiu, iju, iku ! - - 65 INTEGER :: iis, ijs, iks ! - - 66 REAL(wp) :: zzz ! local real 67 INTEGER , DIMENSION(3) :: ilocu, ilocs 68 INTEGER , DIMENSION(2) :: iloch 69 REAL(wp), DIMENSION(4) :: zmax 63 INTEGER :: ji, jj, jk ! dummy loop indices 64 INTEGER, DIMENSION(2) :: ih ! min/max loc indices 65 INTEGER, DIMENSION(3) :: iu, is1, is2 ! min/max loc indices 66 REAL(wp) :: zzz ! local real 67 REAL(wp), DIMENSION(5) :: zmax 68 CHARACTER(len=20) :: clname 70 69 !!---------------------------------------------------------------------- 71 70 ! … … 75 74 WRITE(numout,*) '~~~~~~~' 76 75 ! ! open time.step file 77 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )76 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 78 77 ! ! open run.stat file 79 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 80 81 IF( lwm ) THEN 82 istatus = NF90_CREATE( 'run.stat.nc', NF90_CLOBBER, idrun ) 78 IF( ln_ctl .AND. lwm ) THEN 79 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 80 clname = 'run.stat.nc' 81 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 82 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, idrun ) 83 83 istatus = NF90_DEF_DIM( idrun, 'time', NF90_UNLIMITED, idtime ) 84 84 istatus = NF90_DEF_VAR( idrun, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), idssh ) 85 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 85 istatus = NF90_DEF_VAR( idrun, 'abs_u_max', NF90_DOUBLE, (/ idtime /), idu ) 86 istatus = NF90_DEF_VAR( idrun, 's_min', NF90_DOUBLE, (/ idtime /), ids1 ) 87 istatus = NF90_DEF_VAR( idrun, 's_max', NF90_DOUBLE, (/ idtime /), ids2 ) 86 88 istatus = NF90_ENDDEF(idrun) 87 89 ENDIF 88 89 90 ENDIF 91 IF( kt == nit000 ) lsomeoce = COUNT( ssmask(:,:) == 1._wp ) > 0 90 92 ! 91 IF(lw p) THEN !== current time step ==! ("time.step" file)93 IF(lwm) THEN !== current time step ==! ("time.step" file) 92 94 WRITE ( numstp, '(1x, i8)' ) kt 93 95 REWIND( numstp ) … … 101 103 ENDIF 102 104 zmax(2) = MAXVAL( ABS( un(:,:,:) ) ) ! velocity max (zonal only) 103 !zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max104 zmax( 3) = 0.0_wp105 zmax( 4) = REAL( nstop , wp ) ! stop indicator105 zmax(3) = MAXVAL( -tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) ! minus salinity max 106 zmax(4) = MAXVAL( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) ! salinity max 107 zmax(5) = REAL( nstop , wp ) ! stop indicator 106 108 ! 107 IF( lk_mpp ) THEN 108 CALL mpp_max_multiple( zmax(:), 4 ) ! max over the global domain 109 ! 110 nstop = INT( zmax(4) ) ! nstop indicator sheared among all local domains 109 IF( lk_mpp .AND. ln_ctl ) THEN 110 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 111 nstop = NINT( zmax(5) ) ! nstop indicator sheared among all local domains 111 112 ENDIF 112 ! 113 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 114 WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ', zmax(1), ' |U| max: ', zmax(2) 115 ENDIF 116 ! 117 IF ( zmax(1) > 50._wp .OR. & ! too large sea surface height ( > 10 m) 118 & zmax(2) > 20._wp .OR. & ! too large velocity ( > 10 m/s) 119 !!$ & zmax(3) >= 0._wp .OR. & ! negative or zero sea surface salinity 120 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 121 IF( lk_mpp ) THEN 122 CALL mpp_maxloc( 'stpctl', ABS(sshn) , ssmask(:,:) , zzz, iih, ijh ) 123 CALL mpp_maxloc( 'stpctl', ABS(un) , umask (:,:,:), zzz, iiu, iju, iku ) 124 ! CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, iis, ijs, iks ) 125 ELSE 126 iloch = MINLOC( ABS( sshn(:,:) ) ) 127 ilocu = MAXLOC( ABS( un (:,:,:) ) ) 128 ! ilocs = MINLOC( tsn(:,:,:,jp_sal) , mask = tmask(:,:,:) == 1._wp ) 129 iih = iloch(1) + nimpp - 1 ; ijh = iloch(2) + njmpp - 1 130 iiu = ilocu(1) + nimpp - 1 ; iju = ilocu(2) + njmpp - 1 ; iku = ilocu(3) 131 ! iis = ilocs(1) + nimpp - 1 ; ijs = ilocs(2) + njmpp - 1 ; iks = ilocu(3) 132 ENDIF 133 IF(lwp) THEN 134 WRITE(numout,cform_err) 135 WRITE(numout,*) ' stp_ctl: |ssh| > 50 m or |U| > 20 m/s or NaN encounter in the tests' 136 WRITE(numout,*) ' ======= ' 137 WRITE(numout,9100) kt, zmax(1), iih, ijh 138 WRITE(numout,9200) kt, zmax(2), iiu, iju, iku 139 !!$ WRITE(numout,9300) kt, - zmax(3), iis, ijs, iks 140 WRITE(numout,*) 141 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 142 ENDIF 143 kindic = -3 144 ! 145 nstop = nstop + 1 ! increase nstop by 1 (on all local domains) 146 CALL dia_wri_state( 'output.abort', kt ) ! create an output.abort file 147 ! 148 ENDIF 149 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 150 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 151 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j : ',2i5) 152 ! 153 ! !== run statistics ==! ("run.stat" file) 154 ! IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3) 155 IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2) 156 IF( lwm ) THEN 113 ! !== run statistics ==! ("run.stat" files) 114 IF( ln_ctl .AND. lwm ) THEN 115 WRITE(numrun,9500) kt, zmax(1), zmax(2), -zmax(3), zmax(4) 157 116 istatus = NF90_PUT_VAR( idrun, idssh, (/ zmax(1)/), (/kt/), (/1/) ) 158 117 istatus = NF90_PUT_VAR( idrun, idu, (/ zmax(2)/), (/kt/), (/1/) ) 159 ! istatus = NF90_PUT_VAR( idrun, ids, (/-zmax(3)/), (/kt/), (/1/) ) 118 istatus = NF90_PUT_VAR( idrun, ids1, (/-zmax(3)/), (/kt/), (/1/) ) 119 istatus = NF90_PUT_VAR( idrun, ids2, (/ zmax(4)/), (/kt/), (/1/) ) 160 120 IF( MOD( kt , 100 ) == 0 ) istatus = NF90_SYNC(idrun) 161 121 IF( kt == nitend ) istatus = NF90_CLOSE(idrun) 162 122 END IF 123 ! !== error handling ==! 124 IF( ( ln_ctl .OR. lsomeoce ) .AND. ( & ! have use mpp_max (because ln_ctl=.T.) or contains some ocean points 125 & zmax(1) > 50._wp .OR. & ! too large sea surface height ( > 50 m ) 126 & zmax(2) > 20._wp .OR. & ! too large velocity ( > 20 m/s) 127 & zmax(3) >= 100._wp .OR. & ! too small sea surface salinity ( < -100 ) 128 & zmax(4) >= 100._wp .OR. & ! too large sea surface salinity ( > 100 ) 129 & zmax(4) < -100._wp .OR. & ! too large sea surface salinity (keep this line for sea-ice) 130 & ISNAN( zmax(1) + zmax(2) + zmax(3) ) ) THEN ! NaN encounter in the tests 131 IF( lk_mpp .AND. ln_ctl ) THEN 132 CALL mpp_maxloc( 'stpctl', ABS(sshn) , ssmask(:,:) , zzz, ih ) 133 CALL mpp_maxloc( 'stpctl', ABS(un) , umask (:,:,:), zzz, iu ) 134 CALL mpp_minloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is1 ) 135 CALL mpp_maxloc( 'stpctl', tsn(:,:,:,jp_sal), tmask (:,:,:), zzz, is2 ) 136 ELSE 137 ih(:) = MAXLOC( ABS( sshn(:,:) ) ) + (/ nimpp - 1, njmpp - 1 /) 138 iu(:) = MAXLOC( ABS( un (:,:,:) ) ) + (/ nimpp - 1, njmpp - 1, 0 /) 139 is1(:) = MINLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 140 is2(:) = MAXLOC( tsn(:,:,:,jp_sal), mask = tmask(:,:,:) == 1._wp ) + (/ nimpp - 1, njmpp - 1, 0 /) 141 ENDIF 142 IF( numout == 6 ) & ! force to open ocean.output file 143 CALL ctl_opn( numout, 'ocean.output', 'APPEND', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 144 145 WRITE(numout,cform_err) 146 WRITE(numout,*) ' stp_ctl: |ssh| > 50 m or |U| > 20 m/s or S <= -100 or S >= 100 or NaN encounter in the tests' 147 WRITE(numout,*) ' ======= ' 148 IF( lk_mpp .AND. .NOT. ln_ctl ) WRITE(numout,*) 'E R R O R message from sub-domain: ', narea 149 WRITE(numout,9100) kt, zmax(1), ih(1) , ih(2) 150 WRITE(numout,9200) kt, zmax(2), iu(1) , iu(2) , iu(3) 151 WRITE(numout,9300) kt, - zmax(3), is1(1), is1(2), is1(3) 152 WRITE(numout,9400) kt, zmax(4), is2(1), is2(2), is2(3) 153 WRITE(numout,*) 154 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 155 156 CALL dia_wri_state( 'output.abort' ) ! create an output.abort file 157 158 IF( ln_ctl ) THEN 159 kindic = -3 160 nstop = nstop + 1 ! increase nstop by 1 (on all local domains) 161 ELSE 162 CALL ctl_stop() 163 CALL mppstop(ld_force_abort = .true.) 164 ENDIF 165 ! 166 ENDIF 163 167 ! 164 !9400 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16) 165 9400 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16) 168 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 169 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 170 9300 FORMAT (' kt=',i8,' S min: ',1pg11.4,', at i j k: ',3i5) 171 9400 FORMAT (' kt=',i8,' S max: ',1pg11.4,', at i j k: ',3i5) 172 9500 FORMAT(' it :', i8, ' |ssh|_max: ', D23.16, ' |U|_max: ', D23.16,' S_min: ', D23.16,' S_max: ', D23.16) 166 173 ! 167 174 END SUBROUTINE stp_ctl
Note: See TracChangeset
for help on using the changeset viewer.
