- Timestamp:
- 2018-06-21T11:58:42+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r9816 r9817 32 32 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step 33 33 REAL(wp) :: rdt_sampl 34 INTEGER :: nb_rec_per_day s34 INTEGER :: nb_rec_per_day 35 35 INTEGER :: isecfst, iseclast 36 36 LOGICAL :: llnew … … 55 55 !! Update the passive tracers 56 56 !!------------------------------------------------------------------- 57 58 USE dom_oce, ONLY: narea 59 57 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 58 61 INTEGER :: jk, jn ! dummy loop indices 59 62 REAL(wp) :: ztrai 60 63 CHARACTER (len=25) :: charout 61 62 64 !!------------------------------------------------------------------- 63 65 ! … … 87 89 tra(:,:,:,:) = 0.e0 88 90 ! 91 # if defined key_debug_medusa 92 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 93 CALL flush(numout) 94 # endif 89 95 CALL trc_rst_opn ( kt ) ! Open tracer restart file 96 # if defined key_debug_medusa 97 CALL trc_rst_stat 98 CALL trc_rst_tra_stat 99 # endif 90 100 IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar 91 101 IF( lk_iomput ) THEN ; CALL trc_wri ( kt ) ! output of passive tracers with iom I/O manager … … 93 103 ENDIF 94 104 CALL trc_sms ( kt ) ! tracers: sinks and sources 105 # if defined key_debug_medusa 106 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 107 CALL trc_rst_stat 108 CALL trc_rst_tra_stat 109 CALL flush(numout) 110 # endif 95 111 CALL trc_trp ( kt ) ! transport of passive tracers 112 # if defined key_debug_medusa 113 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 114 CALL trc_rst_stat 115 CALL trc_rst_tra_stat 116 CALL flush(numout) 117 # endif 96 118 IF( kt == nittrc000 ) THEN 97 119 CALL iom_close( numrtr ) ! close input tracer restart file … … 102 124 ! 103 125 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 104 ! 105 ENDIF 106 ! 107 ztrai = 0._wp ! content of all tracers 108 DO jn = 1, jptra 109 ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 110 END DO 111 IF( lwp ) WRITE(numstr,9300) kt, ztrai / areatot 112 9300 FORMAT(i10,e18.10) 126 # if defined key_debug_medusa 127 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 128 CALL flush(numout) 129 # endif 130 ! 131 ENDIF 132 ! 133 IF (ln_ctl) THEN 134 ! The following code is very expensive since it involves multiple 135 ! reproducible global sums over all tracer fields and is potentially 136 ! called on every timestep. The results it produces are purely for 137 ! informational purposes and do not affect model evolution. 138 ! Hence we restrict its use by protecting it with the ln_ctl RTL 139 ! which should normally only be used under debugging conditions 140 ! and not in operational runs. We also need to restrict output 141 ! to the master PE since there's no point duplicating the same results 142 ! on all processors. 143 ztrai = 0._wp ! content of all tracers 144 DO jn = 1, jptra 145 ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 146 END DO 147 IF( numstr /= -1 ) WRITE(numstr,9300) kt, ztrai / areatot 148 9300 FORMAT(i10,D23.16) 149 ENDIF 113 150 ! 114 151 IF( nn_timing == 1 ) CALL timing_stop('trc_stp') … … 123 160 !! of diurnal cycle 124 161 !! 125 !! ** Method : store in TOP the qsr every hour ( or every time-step the latter162 !! ** Method : store in TOP the qsr every hour ( or every time-step if the latter 126 163 !! is greater than 1 hour ) and then, compute the mean with 127 164 !! a moving average over 24 hours. … … 130 167 INTEGER, INTENT(in) :: kt 131 168 INTEGER :: jn 169 REAL(wp) :: zsecfst 170 CHARACTER(len=1) :: cl1 ! 1 character 171 CHARACTER(len=2) :: cl2 ! 2 characters 132 172 133 173 IF( kt == nittrc000 ) THEN 134 174 IF( ln_cpl ) THEN 135 175 rdt_sampl = 86400. / ncpl_qsr_freq 136 nb_rec_per_day s= ncpl_qsr_freq176 nb_rec_per_day = ncpl_qsr_freq 137 177 ELSE 138 178 rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 139 nb_rec_per_day s= INT( 86400 / rdt_sampl )179 nb_rec_per_day = INT( 86400 / rdt_sampl ) 140 180 ENDIF 141 181 ! 142 182 IF( lwp ) THEN 143 183 WRITE(numout,*) 144 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day s184 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day 145 185 WRITE(numout,*) 146 186 ENDIF 147 187 ! 148 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 149 DO jn = 1, nb_rec_per_days 150 qsr_arr(:,:,jn) = qsr(:,:) 151 ENDDO 152 qsr_mean(:,:) = qsr(:,:) 153 ! 154 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 155 iseclast = isecfst 188 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 189 ! 190 ! !* Restart: read in restart file 191 IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 .AND. & 192 iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 .AND. & 193 iom_varid( numrtr, 'zsecfst' , ldstop = .FALSE. ) > 0 ) THEN 194 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file' 195 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr 196 CALL iom_get( numrtr, 'zsecfst', zsecfst ) ! A mean of qsr 197 isecfst = INT( zsecfst ) 198 DO jn = 1, nb_rec_per_day 199 IF( jn <= 9 ) THEN 200 WRITE(cl1,'(i1)') jn 201 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) ! A mean of qsr 202 ELSE 203 WRITE(cl2,'(i2.2)') jn 204 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr 205 ENDIF 206 ENDDO 207 ELSE !* no restart: set from nit000 values 208 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values' 209 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 210 ! 211 qsr_mean(:,:) = qsr(:,:) 212 DO jn = 1, nb_rec_per_day 213 qsr_arr(:,:,jn) = qsr_mean(:,:) 214 ENDDO 215 ENDIF 156 216 ! 157 217 ENDIF 158 218 ! 159 219 iseclast = nsec_year + nsec1jan000 220 ! 160 221 llnew = ( iseclast - isecfst ) > INT( rdt_sampl ) ! new shortwave to store 161 IF( kt /= nittrc000 .AND.llnew ) THEN222 IF( llnew ) THEN 162 223 IF( lwp ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', kt, & 163 224 & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 164 225 isecfst = iseclast 165 DO jn = 1, nb_rec_per_day s- 1226 DO jn = 1, nb_rec_per_day - 1 166 227 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 167 228 ENDDO 168 qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 169 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 229 qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) 230 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day 231 ENDIF 232 ! 233 IF( lrst_trc ) THEN !* Write the mean of qsr in restart file 234 IF(lwp) WRITE(numout,*) 235 IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file kt =', kt 236 IF(lwp) WRITE(numout,*) '~~~~~~~' 237 DO jn = 1, nb_rec_per_day 238 IF( jn <= 9 ) THEN 239 WRITE(cl1,'(i1)') jn 240 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) 241 ELSE 242 WRITE(cl2,'(i2.2)') jn 243 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) 244 ENDIF 245 ENDDO 246 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 247 zsecfst = REAL( isecfst, wp ) 248 CALL iom_rstput( kt, nitrst, numrtw, 'zsecfst', zsecfst ) 170 249 ENDIF 171 250 !
Note: See TracChangeset
for help on using the changeset viewer.