Changeset 11066
- Timestamp:
- 2019-05-28T18:00:55+02:00 (5 years ago)
- Location:
- branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 2 added
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r8058 r11066 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,: ) :: thick0 ! ocean thickness (interior domain) 40 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sn0 ! initial salinity 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn0 ! initial temperature 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshthster_mat ! ssh_thermosteric height 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshhlster_mat ! ssh_halosteric height 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshsteric_mat ! ssh_steric height 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: zbotpres_mat ! bottom pressure 41 46 42 47 !! * Substitutions … … 56 61 !!---------------------------------------------------------------------- 57 62 ! 58 ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk) , STAT=dia_ar5_alloc ) 63 ALLOCATE( area(jpi,jpj), thick0(jpi,jpj) , sn0(jpi,jpj,jpk), tn0(jpi,jpj,jpk) , & 64 & sshthster_mat(jpi,jpj),sshhlster_mat(jpi,jpj),sshsteric_mat(jpi,jpj), & 65 & zbotpres_mat(jpi,jpj),STAT=dia_ar5_alloc ) 59 66 ! 60 67 IF( lk_mpp ) CALL mpp_sum ( dia_ar5_alloc ) … … 85 92 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 86 93 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 94 95 sshthster_mat(:,:) = 0._wp 96 sshhlster_mat(:,:) = 0._wp 97 sshsteric_mat(:,:) = 0._wp 98 zbotpres_mat(:,:) = 0._wp 87 99 88 100 zarea_ssh(:,:) = area(:,:) * sshn(:,:) … … 121 133 zssh_steric = - zarho / area_tot 122 134 CALL iom_put( 'sshthster', zssh_steric ) 135 sshthster_mat(:,:) = -zbotpres(:,:) 136 CALL iom_put( 'sshthster_mat', sshthster_mat ) 137 138 ! 139 ztsn(:,:,:,jp_tem) = tn0(:,:,:) ! thermohaline ssh 140 ztsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 141 CALL eos( ztsn, zrhd, fsdept_n(:,:,:) ) ! now in situ density using initial temperature 142 ! 143 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 144 DO jk = 1, jpkm1 145 zbotpres(:,:) = zbotpres(:,:) + fse3t(:,:,jk) * zrhd(:,:,jk) 146 END DO 147 IF( .NOT.lk_vvl ) THEN 148 IF ( ln_isfcav ) THEN 149 DO ji=1,jpi 150 DO jj=1,jpj 151 zbotpres(ji,jj) = zbotpres(ji,jj) + sshn(ji,jj) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 152 END DO 153 END DO 154 ELSE 155 zbotpres(:,:) = zbotpres(:,:) + sshn(:,:) * zrhd(:,:,1) 156 END IF 157 END IF 158 ! 159 zarho = SUM( area(:,:) * zbotpres(:,:) ) 160 IF( lk_mpp ) CALL mpp_sum( zarho ) 161 zssh_steric = - zarho / area_tot 162 CALL iom_put( 'sshhlster', zssh_steric ) 163 sshhlster_mat(:,:) = -zbotpres(:,:) 164 CALL iom_put( 'sshhlster_mat', sshhlster_mat ) 165 166 123 167 124 168 ! ! steric sea surface height … … 147 191 zssh_steric = - zarho / area_tot 148 192 CALL iom_put( 'sshsteric', zssh_steric ) 193 sshsteric_mat(:,:) = -zbotpres(:,:) 194 CALL iom_put( 'sshsteric_mat', sshsteric_mat ) 149 195 150 196 ! ! ocean bottom pressure 151 197 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa 152 198 zbotpres(:,:) = zztmp * ( zbotpres(:,:) + sshn(:,:) + thick0(:,:) ) 153 CALL iom_put( 'botpres', zbotpres ) 154 199 zbotpres_mat(:,:) = zbotpres(:,:) 200 CALL iom_put( 'botpres', zbotpres_mat ) 201 155 202 ! ! Mean density anomalie, temperature and salinity 156 203 ztemp = 0._wp … … 211 258 REAL(wp) :: zztmp 212 259 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 260 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztemdta ! Jan/Dec levitus salinity 213 261 ! reading initial file 214 262 LOGICAL :: ln_tsd_init !: T & S data flag … … 234 282 ! 235 283 CALL wrk_alloc( jpi , jpj , jpk, jpts, zsaldta ) 284 CALL wrk_alloc( jpi , jpj , jpk, jpts, ztemdta ) 236 285 ! ! allocate dia_ar5 arrays 237 286 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) … … 253 302 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 254 303 CALL iom_close( inum ) 304 305 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_tem%clname), inum ) 306 CALL iom_get ( inum, jpdom_data, TRIM(sn_tem%clvar), ztemdta(:,:,:,1), 1 ) 307 CALL iom_get ( inum, jpdom_data, TRIM(sn_tem%clvar), ztemdta(:,:,:,2), 12 ) 308 CALL iom_close( inum ) 255 309 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 256 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 310 tn0(:,:,:) = 0.5_wp * ( ztemdta(:,:,:,1) + ztemdta(:,:,:,2) ) 311 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 312 tn0(:,:,:) = tn0(:,:,:) * tmask(:,:,:) 257 313 IF( ln_zps ) THEN ! z-coord. partial steps 258 314 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) … … 262 318 zztmp = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 263 319 sn0(ji,jj,ik) = ( 1._wp - zztmp ) * sn0(ji,jj,ik) + zztmp * sn0(ji,jj,ik-1) 320 tn0(ji,jj,ik) = ( 1._wp - zztmp ) * tn0(ji,jj,ik) + zztmp * tn0(ji,jj,ik-1) 264 321 ENDIF 265 322 END DO … … 268 325 ! 269 326 CALL wrk_dealloc( jpi , jpj , jpk, jpts, zsaldta ) 327 CALL wrk_dealloc( jpi , jpj , jpk, jpts, ztemdta ) 270 328 ! 271 329 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init') -
branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r10237 r11066 35 35 USE phycst ! physical constants 36 36 USE in_out_manager ! I/O manager 37 USE iom ! I/0 library 37 38 USE daymod ! calendar 38 39 USE dianam ! build name of file … … 65 66 !! * Shared module variables 66 67 LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .TRUE. !: model-data diagnostics flag 68 LOGICAL, PUBLIC :: ln_dct_calc_noos_25h !: Calcuate noos 25 h means 69 LOGICAL, PUBLIC :: ln_dct_calc_noos_hr !: Calcuate noos hourly means 70 ! JT 71 LOGICAL, PUBLIC :: ln_dct_iom_cont !: Use IOM Output? 72 LOGICAL, PUBLIC :: ln_dct_ascii !: Output ascii or binary 73 LOGICAL, PUBLIC :: ln_dct_h !: Output hourly instantaneous or mean values 74 ! JT 67 75 68 76 !! * Module variables 69 INTEGER :: nn_dct = 1! Frequency of computation70 INTEGER :: nn_dctwri = 1! Frequency of output71 INTEGER :: nn_secdebug = 0! Number of the section to debug72 INTEGER :: nn_dct_h = 1! Frequency of computation for NOOS hourly files73 INTEGER :: nn_dctwri_h = 1! Frequency of output for NOOS hourly files77 INTEGER :: nn_dct ! Frequency of computation 78 INTEGER :: nn_dctwri ! Frequency of output 79 INTEGER :: nn_secdebug ! Number of the section to debug 80 INTEGER :: nn_dct_h ! Frequency of computation for NOOS hourly files 81 INTEGER :: nn_dctwri_h ! Frequency of output for NOOS hourly files 74 82 75 83 INTEGER, PARAMETER :: nb_class_max = 12 ! maximum number of classes, i.e. depth levels or density classes 76 INTEGER, PARAMETER :: nb_sec_max = 30! maximum number of sections77 INTEGER, PARAMETER :: nb_point_max = 3 00! maximum number of points in a single section84 INTEGER, PARAMETER :: nb_sec_max = 100 ! maximum number of sections 85 INTEGER, PARAMETER :: nb_point_max = 375 ! maximum number of points in a single section 78 86 INTEGER, PARAMETER :: nb_type_class = 14 ! types of calculations, i.e. pos transport, neg transport, heat transport, salt transport 79 87 INTEGER, PARAMETER :: nb_3d_vars = 5 … … 134 142 ALLOCATE(transports_3d_h(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(3) ) 135 143 ALLOCATE(transports_2d_h(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(4) ) 136 ALLOCATE(z_hr_output(nb_sec_max, 168,nb_class_max) , STAT=ierr(5) ) ! 168 = 24 * 7days144 ALLOCATE(z_hr_output(nb_sec_max,3,nb_class_max) , STAT=ierr(5) ) 137 145 138 146 diadct_alloc = MAXVAL( ierr ) … … 149 157 !! 150 158 !!--------------------------------------------------------------------- 151 NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug 152 INTEGER :: ios ! Local integer output status for namelist read 159 NAMELIST/namdct/nn_dct,ln_dct_h,nn_dctwri,ln_dct_ascii,nn_secdebug,ln_dct_calc_noos_25h,ln_dct_calc_noos_hr,ln_dct_iom_cont 160 INTEGER :: ios,jsec ! Local integer output status for namelist read 161 CHARACTER(len=3) :: jsec_str ! name of the jsec 153 162 154 163 IF( nn_timing == 1 ) CALL timing_start('dia_dct_init') … … 164 173 165 174 IF( ln_NOOS ) THEN 166 nn_dct=3600./rdt ! hard coded for NOOS transects, to give 25 hour means 175 176 !Do calculation for daily, 25hourly mean every hour 177 nn_dct=3600./rdt ! hard coded for NOOS transects, to give 25 hour means from hourly instantaneous values 178 179 !write out daily, 25hourly mean every day 167 180 nn_dctwri=86400./rdt 168 nn_dct_h=1 ! hard coded for NOOS transects, to give hourly data 181 182 183 !nn_dct_h=1 ! hard coded for NOOS transects, to give hourly data 184 ! If you want hourly instantaneous values, you only do the calculation every 12 timesteps (if rdt = 300) 185 ! and output it every 12 time steps. For this, you set the ln_dct_h to be True, and it calcuates it automatically 186 ! if you want hourly mean values, set ln_dct_h to be False, and it will do the calculate every time step. 187 ! 188 !SELECT CASE( ln_dct_h ) 189 ! CASE(.TRUE.) 190 ! nn_dct_h=3600./rdt 191 ! CASE(.FALSE.) 192 ! nn_dct_h=1 193 !END SELECT 194 195 IF ( ln_dct_h ) THEN 196 nn_dct_h=3600./rdt 197 ELSE 198 nn_dct_h=1. 199 ENDIF 200 201 !JT write out hourly calculation every hour 169 202 nn_dctwri_h=3600./rdt 170 203 ENDIF … … 175 208 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 176 209 IF( ln_NOOS ) THEN 210 WRITE(numout,*) " Calculate NOOS hourly output: ln_dct_calc_noos_hr = ",ln_dct_calc_noos_hr 211 WRITE(numout,*) " Calculate NOOS 25 hour mean output: ln_dct_calc_noos_hr = ",ln_dct_calc_noos_25h 212 WRITE(numout,*) " Use IOM Output: ln_dct_iom_cont = ",ln_dct_iom_cont 213 WRITE(numout,*) " Output in ASCII (True) or Binary (False): ln_dct_ascii = ",ln_dct_ascii 214 WRITE(numout,*) " Frequency of hourly computation - instantaneous (TRUE) or hourly mean (FALSE): ln_dct_h = ",ln_dct_h 215 177 216 WRITE(numout,*) " Frequency of computation hard coded to be every hour: nn_dct = ",nn_dct 178 217 WRITE(numout,*) " Frequency of write hard coded to average 25 instantaneous hour values: nn_dctwri = ",nn_dctwri 179 WRITE(numout,*) " Frequency of hourly computation hard coded to be every timestep: nn_dct_h = ",nn_dct_h 218 WRITE(numout,*) " Frequency of hourly computation (timestep) : nn_dct_h = ",nn_dct_h 219 WRITE(numout,*) " Frequency of hourly computation Not hard coded to be every timestep, or : nn_dct_h = ",nn_dct_h 180 220 WRITE(numout,*) " Frequency of hourly write hard coded to every hour: nn_dctwri_h = ",nn_dctwri_h 181 221 ELSE … … 195 235 196 236 ENDIF 197 198 !Read section_ijglobal.diadct 199 CALL readsec 237 238 239 IF ( ln_NOOS ) THEN 240 IF ( ln_dct_calc_noos_25h .or. ln_dct_calc_noos_hr ) CALL readsec 241 ENDIF 200 242 201 243 !open output file 202 IF( lw m) THEN244 IF( lwp ) THEN 203 245 IF( ln_NOOS ) THEN 204 CALL ctl_opn( numdct_NOOS ,'NOOS_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 205 CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 246 WRITE(numout,*) "diadct_init: Open output files. ASCII? ",ln_dct_ascii 247 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 248 IF ( ln_dct_ascii ) THEN 249 if ( ln_dct_calc_noos_25h ) CALL ctl_opn( numdct_NOOS ,'NOOS_transport' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 250 if ( ln_dct_calc_noos_hr ) CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 251 ELSE 252 if ( ln_dct_calc_noos_25h ) CALL ctl_opn( numdct_NOOS ,'NOOS_transport_bin' , 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 253 if ( ln_dct_calc_noos_hr ) CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_bin_h', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 254 ENDIF 206 255 ELSE 207 256 CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) … … 212 261 213 262 ! Initialise arrays to zero 214 transports_3d(:,:,:,:) =0.0215 transports_2d(:,:,:) =0.0216 transports_3d_h(:,:,:,:) =0._wp217 transports_2d_h(:,:,:) =0._wp218 z_hr_output(:,:,:) =0._wp263 transports_3d(:,:,:,:) =0._wp 264 transports_2d(:,:,:) =0._wp 265 transports_3d_h(:,:,:,:) =0._wp 266 transports_2d_h(:,:,:) =0._wp 267 z_hr_output(:,:,:) =0._wp 219 268 220 269 IF( nn_timing == 1 ) CALL timing_stop('dia_dct_init') 270 271 IF (ln_dct_iom_cont) THEN 272 IF( lwp ) THEN 273 WRITE(numout,*) " " 274 WRITE(numout,*) "diadct_init: using xios iom_put for output: field_def.xml and iodef.xml code" 275 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 276 WRITE(numout,*) "" 277 WRITE(numout,*) " field_def.xml" 278 WRITE(numout,*) " ~~~~~~~~~~~~~" 279 WRITE(numout,*) "" 280 WRITE(numout,*) "" 281 282 WRITE(numout,*) ' <field_group id="noos_cross_section" domain_ref="1point" axis_ref="noos" operation="average">' 283 284 DO jsec=1,nb_sec 285 WRITE (jsec_str, "(I3.3)") jsec 286 287 WRITE(numout,*) ' <field id="noos_'//jsec_str//'_trans" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS transport cross-section number: '//jsec_str//' (total, positive, negative)" unit="m^3/s" />' 288 WRITE(numout,*) ' <field id="noos_'//jsec_str//'_heat" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS heat cross-section number: '//jsec_str//' (total, positive, negative)" unit="J/s" />' 289 WRITE(numout,*) ' <field id="noos_'//jsec_str//'_salt" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS salt cross-section number: '//jsec_str//' (total, positive, negative)" unit="g/s" />' 290 291 ENDDO 292 293 WRITE(numout,*) ' </field_group>' 294 295 WRITE(numout,*) "" 296 WRITE(numout,*) "" 297 WRITE(numout,*) " iodef.xml" 298 WRITE(numout,*) " ~~~~~~~~~" 299 WRITE(numout,*) "" 300 WRITE(numout,*) "" 301 302 WRITE(numout,*) ' <file_group id="1d" output_freq="1d" output_level="10" enabled=".TRUE.">' 303 WRITE(numout,*) "" 304 WRITE(numout,*) ' <file id="noos_cross_section" name="NOOS_transport">' 305 DO jsec=1,nb_sec 306 WRITE (jsec_str, "(I3.3)") jsec 307 308 WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_trans" />' 309 WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_heat" />' 310 WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_salt" />' 311 312 ENDDO 313 WRITE(numout,*) ' </file>' 314 WRITE(numout,*) "" 315 WRITE(numout,*) ' </file_group>' 316 317 WRITE(numout,*) "" 318 WRITE(numout,*) "" 319 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 320 WRITE(numout,*) "" 321 322 ENDIF 323 ENDIF 324 325 221 326 ! 222 327 END SUBROUTINE dia_dct_init … … 231 336 !! Method :: All arrays initialised to zero in dct_init 232 337 !! Each nn_dct time step call subroutine 'transports' for 233 !! each section to sum the transports over each grid cell.338 !! each section to sum the transports. 234 339 !! Each nn_dctwri time step: 235 340 !! Divide the arrays by the number of summations to gain … … 271 376 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~~~~~" 272 377 WRITE(numout,*) "nb_sec = ",nb_sec 378 WRITE(numout,*) "nn_dct = ",nn_dct 379 WRITE(numout,*) "ln_NOOS = ",ln_NOOS 380 WRITE(numout,*) "nb_sec = ",nb_sec 381 WRITE(numout,*) "nb_sec_max = ",nb_sec_max 382 WRITE(numout,*) "nb_type_class = ",nb_type_class 383 WRITE(numout,*) "nb_class_max = ",nb_class_max 273 384 ENDIF 274 385 275 276 ! Compute transport and write only at nn_dctwri 277 IF( MOD(kt,nn_dct)==0 .or. & ! compute transport every nn_dct time steps 278 (ln_NOOS .and. kt==nn_it000 ) ) THEN ! also include first time step when calculating NOOS 25 hour averages 279 280 DO jsec=1,nb_sec 281 282 !debug this section computing ? 283 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 284 285 !Compute transport through section 286 CALL transport(secs(jsec),lldebug,jsec) 287 288 ENDDO 289 290 IF( MOD(kt,nn_dctwri)==0 )THEN 291 292 IF( lwp .AND. kt==nit000+nn_dctwri-1 )WRITE(numout,*)" diadct: average transports and write at kt = ",kt 293 294 !! divide arrays by nn_dctwri/nn_dct to obtain average 295 transports_3d(:,:,:,:)=transports_3d(:,:,:,:)/(nn_dctwri/nn_dct) 296 transports_2d(:,:,:) =transports_2d(:,:,:) /(nn_dctwri/nn_dct) 297 298 ! Sum over each class 299 DO jsec=1,nb_sec 300 CALL dia_dct_sum(secs(jsec),jsec) 301 ENDDO 302 303 !Sum on all procs 304 IF( lk_mpp )THEN 305 zsum(:,:,:)=0.0_wp 306 ish(1) = nb_sec_max*nb_type_class*nb_class_max 307 ish2 = (/nb_sec_max,nb_type_class,nb_class_max/) 308 DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport(:,:) ; ENDDO 309 zwork(:)= RESHAPE(zsum(:,:,:), ish ) 310 CALL mpp_sum(zwork, ish(1)) 311 zsum(:,:,:)= RESHAPE(zwork,ish2) 312 DO jsec=1,nb_sec ; secs(jsec)%transport(:,:) = zsum(jsec,:,:) ; ENDDO 313 ENDIF 314 315 !Write the transport 316 DO jsec=1,nb_sec 317 318 IF( lwm .and. .not. ln_NOOS )CALL dia_dct_wri(kt,jsec,secs(jsec)) 319 IF( lwm .and. ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec)) ! use NOOS specific formatting 386 387 IF ( ln_dct_calc_noos_25h ) THEN 388 389 ! Compute transport and write only at nn_dctwri 390 IF ( MOD(kt,nn_dct)==0 .or. & ! compute transport every nn_dct time steps 391 (ln_NOOS .and. kt==nn_it000 ) ) THEN ! also include first time step when calculating NOOS 25 hour averages 320 392 321 !nullify transports values after writing 322 transports_3d(:,jsec,:,:)=0. 323 transports_2d(:,jsec,: )=0. 324 secs(jsec)%transport(:,:)=0. 325 IF ( ln_NOOS ) CALL transport(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values) 326 327 ENDDO 328 329 ENDIF 330 393 394 395 DO jsec=1,nb_sec 396 397 lldebug=.FALSE. 398 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE. 399 400 !Compute transport through section 401 CALL transport(secs(jsec),lldebug,jsec) 402 403 404 ENDDO 405 406 IF( MOD(kt,nn_dctwri)==0 )THEN 407 408 409 410 IF( lwp .AND. kt==nit000+nn_dctwri-1 ) WRITE(numout,*)" diadct: average and write at kt = ",kt 411 412 413 ! Not 24 values, but 25! divide by ((nn_dctwri/nn_dct) +1) 414 !! divide arrays by nn_dctwri/nn_dct to obtain average 415 transports_3d(:,:,:,:)= transports_3d(:,:,:,:)/((nn_dctwri/nn_dct)+1.) 416 transports_2d(:,:,:) = transports_2d(:,:,:) /((nn_dctwri/nn_dct)+1.) 417 418 ! Sum over each class 419 DO jsec=1,nb_sec 420 CALL dia_dct_sum(secs(jsec),jsec) 421 ENDDO 422 423 !Sum on all procs 424 IF( lk_mpp )THEN 425 zsum(:,:,:)=0.0_wp 426 ish(1) = nb_sec_max*nb_type_class*nb_class_max 427 ish2 = (/nb_sec_max,nb_type_class,nb_class_max/) 428 DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport(:,:) ; ENDDO 429 zwork(:)= RESHAPE(zsum(:,:,:), ish ) 430 CALL mpp_sum(zwork, ish(1)) 431 zsum(:,:,:)= RESHAPE(zwork,ish2) 432 DO jsec=1,nb_sec ; secs(jsec)%transport(:,:) = zsum(jsec,:,:) ; ENDDO 433 ENDIF 434 435 !Write the transport 436 DO jsec=1,nb_sec 437 438 IF( lwp .and. .not. ln_NOOS )CALL dia_dct_wri(kt,jsec,secs(jsec)) 439 !IF( lwp .and. ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec)) ! use NOOS specific formatting 440 IF( ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec)) ! use NOOS specific formatting 441 442 443 !nullify transports values after writing 444 transports_3d(:,jsec,:,:)=0.0 445 transports_2d(:,jsec,: )=0.0 446 secs(jsec)%transport(:,:)=0. 447 448 449 IF ( ln_NOOS ) CALL transport(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values) 450 451 452 453 ENDDO 454 455 ENDIF 456 457 ENDIF 458 459 ENDIF 460 IF ( ln_dct_calc_noos_hr ) THEN 461 IF ( MOD(kt,nn_dct_h)==0 ) THEN ! compute transport every nn_dct_h time steps 462 463 DO jsec=1,nb_sec 464 465 lldebug=.FALSE. 466 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct_h-1 .AND. lwp ) lldebug=.TRUE. 467 468 !Compute transport through section 469 CALL transport_h(secs(jsec),lldebug,jsec) 470 471 ENDDO 472 473 IF( MOD(kt,nn_dctwri_h)==0 )THEN 474 475 IF( lwp .AND. kt==nit000+nn_dctwri_h-1 )WRITE(numout,*)" diadct: average and write hourly files at kt = ",kt 476 477 !! divide arrays by nn_dctwri/nn_dct to obtain average 478 ! 479 ! JT - I think this is wrong. I think it is trying to sum over 25 hours, but only dividing by 24. 480 ! I think it might work for daily cycles, but not for monthly cycles, 481 ! 482 transports_3d_h(:,:,:,:)=transports_3d_h(:,:,:,:)/(nn_dctwri_h/nn_dct_h) 483 transports_2d_h(:,:,:) =transports_2d_h(:,:,:) /(nn_dctwri_h/nn_dct_h) 484 485 ! Sum over each class 486 DO jsec=1,nb_sec 487 CALL dia_dct_sum_h(secs(jsec),jsec) 488 ENDDO 489 490 !Sum on all procs 491 IF( lk_mpp )THEN 492 ish(1) = nb_sec_max*nb_type_class*nb_class_max 493 ish2 = (/nb_sec_max,nb_type_class,nb_class_max/) 494 DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport_h(:,:) ; ENDDO 495 zwork(:)= RESHAPE(zsum(:,:,:), ish ) 496 CALL mpp_sum(zwork, ish(1)) 497 zsum(:,:,:)= RESHAPE(zwork,ish2) 498 DO jsec=1,nb_sec ; secs(jsec)%transport_h(:,:) = zsum(jsec,:,:) ; ENDDO 499 ENDIF 500 501 !Write the transport 502 DO jsec=1,nb_sec 503 504 IF( lwp .and. ln_NOOS ) THEN 505 CALL dia_dct_wri_NOOS_h(kt/nn_dctwri_h,jsec,secs(jsec)) ! use NOOS specific formatting 506 endif 507 !nullify transports values after writing 508 transports_3d_h(:,jsec,:,:)=0.0 509 transports_2d_h(:,jsec,:)=0.0 510 secs(jsec)%transport_h(:,:)=0.0 511 512 ! for hourly mean or hourly instantaneous, you don't initialise! start with zero! 513 !IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values) 514 515 ENDDO 516 517 ENDIF 518 519 ENDIF 520 331 521 ENDIF 332 333 IF ( MOD(kt,nn_dct_h)==0 ) THEN ! compute transport every nn_dct_h time steps334 335 DO jsec=1,nb_sec336 337 !lldebug=.FALSE.338 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct_h-1 .AND. lwp ) lldebug=.TRUE.339 340 !Compute transport through section341 CALL transport_h(secs(jsec),lldebug,jsec)342 343 ENDDO344 345 IF( MOD(kt,nn_dctwri_h)==0 )THEN346 347 IF( lwp .AND. kt==nit000+nn_dctwri_h-1 )WRITE(numout,*)" diadct: average and write hourly files at kt = ",kt348 349 !! divide arrays by nn_dctwri/nn_dct to obtain average350 transports_3d_h(:,:,:,:)=transports_3d_h(:,:,:,:)/(nn_dctwri_h/nn_dct_h)351 transports_2d_h(:,:,:) =transports_2d_h(:,:,:) /(nn_dctwri_h/nn_dct_h)352 353 ! Sum over each class354 DO jsec=1,nb_sec355 CALL dia_dct_sum_h(secs(jsec),jsec)356 ENDDO357 358 !Sum on all procs359 IF( lk_mpp )THEN360 ish(1) = nb_sec_max*nb_type_class*nb_class_max361 ish2 = (/nb_sec_max,nb_type_class,nb_class_max/)362 DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport_h(:,:) ; ENDDO363 zwork(:)= RESHAPE(zsum(:,:,:), ish )364 CALL mpp_sum(zwork, ish(1))365 zsum(:,:,:)= RESHAPE(zwork,ish2)366 DO jsec=1,nb_sec ; secs(jsec)%transport_h(:,:) = zsum(jsec,:,:) ; ENDDO367 ENDIF368 369 !Write the transport370 DO jsec=1,nb_sec371 372 IF( lwp .and. ln_NOOS )CALL dia_dct_wri_NOOS_h(kt/nn_dctwri_h,jsec,secs(jsec)) ! use NOOS specific formatting373 374 !nullify transports values after writing375 transports_3d_h(:,jsec,:,:)=0.0376 transports_2d_h(:,jsec,:)=0.0377 secs(jsec)%transport_h(:,:)=0.378 IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values)379 380 ENDDO381 382 ENDIF383 384 ENDIF385 522 386 523 IF( lk_mpp )THEN … … 424 561 !open input file 425 562 !--------------- 426 CALL ctl_opn( numdct_in, 'section_ijglobal.diadct', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 563 !write(numout,*) 'dct low-level pre open: little endian ' 564 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='LITTLE_ENDIAN') 565 566 write(numout,*) 'dct low-level pre open: big endian :',nproc,narea 567 OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='BIG_ENDIAN') 568 569 !write(numout,*) 'dct low-level pre open: SWAP ' 570 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='SWAP') 571 572 !write(numout,*) 'dct low-level pre open: NATIVE ' 573 !OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='NATIVE') 574 575 READ(107) isec 576 CLOSE(107) 577 578 CALL ctl_opn( numdct_in, 'section_ijglobal.diadct', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. ) 427 579 428 580 !--------------- … … 433 585 434 586 IF ( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) ) & 435 & WRITE(numout,*)'debug ing for section number: ',jsec587 & WRITE(numout,*)'debugging for section number: ',jsec 436 588 437 589 !initialization 438 590 !--------------- 439 591 secs(jsec)%name='' 440 secs(jsec)%llstrpond = .FALSE. ; secs(jsec)%ll_ice_section = .FALSE. 441 secs(jsec)%ll_date_line = .FALSE. ; secs(jsec)%nb_class = 0 442 secs(jsec)%zsigi = 99._wp ; secs(jsec)%zsigp = 99._wp 443 secs(jsec)%zsal = 99._wp ; secs(jsec)%ztem = 99._wp 444 secs(jsec)%zlay = 99._wp 445 secs(jsec)%transport = 0._wp ; secs(jsec)%nb_point = 0 446 secs(jsec)%transport_h = 0._wp ; secs(jsec)%nb_point = 0 592 secs(jsec)%llstrpond = .FALSE. 593 secs(jsec)%ll_ice_section = .FALSE. 594 secs(jsec)%ll_date_line = .FALSE. 595 secs(jsec)%nb_class = 0 596 secs(jsec)%zsigi = 99._wp 597 secs(jsec)%zsigp = 99._wp 598 secs(jsec)%zsal = 99._wp 599 secs(jsec)%ztem = 99._wp 600 secs(jsec)%zlay = 99._wp 601 secs(jsec)%transport = 0._wp 602 secs(jsec)%transport_h = 0._wp 603 secs(jsec)%nb_point = 0 447 604 448 605 !read section's number / name / computing choices / classes / slopeSection / points number 449 606 !----------------------------------------------------------------------------------------- 450 READ(numdct_in,iostat=iost)isec 451 IF (iost .NE. 0 )EXIT !end of file 607 608 READ(numdct_in,iostat=iost) isec 609 IF (iost .NE. 0 ) then 610 write(numout,*) 'unable to read section_ijglobal.diadct. iost = ',iost 611 EXIT !end of file 612 ENDIF 613 614 452 615 WRITE(cltmp,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec 453 IF( jsec .NE. isec )CALL ctl_stop( cltmp )454 455 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )WRITE(numout,*)"isec ",isec616 617 618 IF( jsec .NE. isec ) CALL ctl_stop( cltmp ) 456 619 457 620 READ(numdct_in)secs(jsec)%name … … 483 646 484 647 WRITE(numout,*) " Section name : ",TRIM(secs(jsec)%name) 485 WRITE(numout,*) " Compute heat and salt transport? ",secs(jsec)%llstrpond648 WRITE(numout,*) " Compute temperature and salinity transports ? ",secs(jsec)%llstrpond 486 649 WRITE(numout,*) " Compute ice transport ? ",secs(jsec)%ll_ice_section 487 650 WRITE(numout,*) " Section crosses date-line ? ",secs(jsec)%ll_date_line … … 558 721 ENDIF 559 722 560 723 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 561 724 DO jpt = 1,iptloc 562 725 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1 563 726 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 564 727 ENDDO 565 728 ENDIF 566 729 567 730 !remove redundant points between processors … … 602 765 603 766 nb_sec = jsec-1 !number of section read in the file 767 768 IF( lwp ) WRITE(numout,*)'diadct: read sections: Finished readsec.' 604 769 605 770 CALL wrk_dealloc( nb_point_max, directemp ) … … 703 868 !! loop on the level jk !! 704 869 !! 705 !! Output :: Arrays containing the volume,density,heat,salt transports for each i706 !! point in a section, summed over each nn_dct.870 !! ** Output: Arrays containing the volume,density,salinity,temperature etc 871 !! transports for each point in a section, summed over each nn_dct. 707 872 !! 708 873 !!------------------------------------------------------------------------------------------- … … 713 878 714 879 !! * Local variables 715 INTEGER :: jk, jseg, jclass,jl, &!loop on level/segment/classes/ice categories716 isgnu , isgnv !717 REAL(wp) :: zumid, zvmid, &!U/V velocity on a cell segment718 zumid_ice, zvmid_ice, &!U/V ice velocity719 zTnorm !transport of velocity through one cell's sides720 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep !temperature/salinity/potential density/ssh/depth at u/v point880 INTEGER :: jk,jseg,jclass, &!loop on level/segment/classes 881 isgnu , isgnv ! 882 REAL(wp):: zumid , zvmid , &!U/V velocity on a cell segment 883 zumid_ice , zvmid_ice , &!U/V ice velocity 884 zTnorm !transport of velocity through one cell's sides 885 REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point 721 886 722 887 TYPE(POINT_SECTION) :: k 723 888 !!-------------------------------------------------------- 724 889 725 !!NIALL IF( ld_debug )WRITE(numout,*)' Compute transport'890 IF( ld_debug )WRITE(numout,*)' Compute transport (jsec,sec%nb_point,sec%slopeSection) : ', jsec,sec%nb_point,sec%slopeSection 726 891 727 892 !---------------------------! … … 730 895 IF(sec%nb_point .NE. 0)THEN 731 896 897 !---------------------------------------------------------------------------------------------------- 898 !---------------------------------------------------------------------------------------------------- 899 !---------------------------------------------------------------------------------------------------- 900 ! 901 ! 902 ! ! ! ! JT 1/09/2018 - changing convention. Always direction + is toward left hand of section 903 ! 904 ! Making sign of the velocities used to calculate the volume transport a function of direction, not slopesection 905 ! (isgnu, isgnv) 906 ! 907 ! They vary for each segment of the section. 908 ! 909 !---------------------------------------------------------------------------------------------------- 910 !---------------------------------------------------------------------------------------------------- 732 911 !---------------------------------------------------------------------------------------------------- 733 912 !Compute sign for velocities: … … 751 930 ! 752 931 !---------------------------------------------------------------------------------------------------- 753 isgnu = 1754 IF( sec%slopeSection .GT. 0 ) THEN ; isgnv = -1755 ELSE ; isgnv = 1756 ENDIF757 IF( sec%slopeSection .GE. 9999. ) isgnv = 1758 932 759 933 IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv … … 763 937 !--------------------------------------! 764 938 DO jseg=1,MAX(sec%nb_point-1,0) 765 939 940 941 !Compute sign for velocities: 942 943 !isgnu = 1 944 !isgnv = 1 945 ! 946 !changing sign of u and v is dependent on the direction of the section. 947 !isgnu = 1 948 !isgnv = 1 949 !SELECT CASE( sec%direction(jseg) ) 950 !CASE(0) ; isgnv = -1 951 !CASE(3) ; isgnu = -1 952 !END SELECT 953 954 955 SELECT CASE( sec%direction(jseg) ) 956 CASE(0) 957 isgnu = 1 958 isgnv = -1 959 CASE(1) 960 isgnu = 1 961 isgnv = 1 962 CASE(2) 963 isgnu = 1 964 isgnv = 1 965 CASE(3) 966 isgnu = -1 967 isgnv = 1 968 END SELECT 969 766 970 !------------------------------------------------------------------------------------------- 767 971 ! Select the appropriate coordinate for computing the velocity of the segment 972 ! Corrected by JT 01/09/2018 (#) 768 973 ! 769 974 ! CASE(0) Case (2) 770 975 ! ------- -------- 771 976 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 772 ! F(i,j)--------- -V(i+1,j)-------F(i+1,j)|773 ! 774 ! 775 ! 776 ! Case (3) 777 ! -------- 778 ! 977 ! F(i,j)---------#V(i,j)-------F(i+1,j) | 978 ! --------> | 979 ! | | 980 ! | | 981 ! Case (3) | U(i,j) 982 ! -------- | | 983 ! V | 779 984 ! listPoint(jseg+1) F(i,j+1) | 780 985 ! | | 781 986 ! | | 782 987 ! | listPoint(jseg+1) F(i,j-1) 783 ! 784 ! 785 ! 786 ! 787 ! 988 ! ^ | 989 ! | | 990 ! | U(i,j+1) 991 ! | | Case(1) 992 ! | | ------ 788 993 ! | 789 994 ! | listPoint(jseg+1) listPoint(jseg) 790 ! | F(i-1,j)---------- -V(i,j) -------f(jseg)791 ! listPoint(jseg) F(i,j) 995 ! | F(i-1,j)----------#V(i-1,j) ------#f(i,j) 996 ! listPoint(jseg) F(i,j) <------- 792 997 ! 793 998 !------------------------------------------------------------------------------------------- … … 800 1005 END SELECT 801 1006 802 !---------------------------| 803 ! LOOP ON THE LEVEL | 804 !---------------------------| 805 !Sum of the transport on the vertical 806 DO jk=1,mbathy(k%I,k%J) 807 808 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 809 SELECT CASE( sec%direction(jseg) ) 810 CASE(0,1) 811 ztn = interp(k%I,k%J,jk,'V',0 ) 812 zsn = interp(k%I,k%J,jk,'V',1 ) 813 zrhop = interp(k%I,k%J,jk,'V',2 )814 zrhoi = interp(k%I,k%J,jk,'V',3 )815 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 816 CASE(2,3) 817 ztn = interp(k%I,k%J,jk,'U',0 )818 zsn = interp(k%I,k%J,jk,'U',1 )819 zrhop = interp(k%I,k%J,jk,'U',2 )820 zrhoi = interp(k%I,k%J,jk,'U',3 )821 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 822 END SELECT 823 824 zfsdep= fsdept(k%I,k%J,jk) 825 826 !compute velocity with the correct direction 827 SELECT CASE( sec%direction(jseg) ) 828 CASE(0,1) 829 zumid=0. 830 zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk) 831 CASE(2,3) 832 zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk) 833 zvmid=0. 834 END SELECT 835 836 !zTnorm=transport through one cell; 837 !velocity* cell's length * cell's thickness 838 zTnorm=zumid*e2u(k%I,k%J)* fse3u(k%I,k%J,jk)+ & 839 zvmid*e1v(k%I,k%J)* fse3v(k%I,k%J,jk) 1007 !---------------------------| 1008 ! LOOP ON THE LEVEL | 1009 !---------------------------| 1010 !Sum of the transport on the vertical 1011 DO jk=1,mbathy(k%I,k%J) 1012 1013 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 1014 SELECT CASE( sec%direction(jseg) ) 1015 CASE(0,1) 1016 ztn = interp(k%I,k%J,jk,'V',0 ) 1017 zsn = interp(k%I,k%J,jk,'V',1 ) 1018 zrhop = interp(k%I,k%J,jk,'V',2) 1019 zrhoi = interp(k%I,k%J,jk,'V',3) 1020 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 1021 CASE(2,3) 1022 ztn = interp(k%I,k%J,jk,'U',0) 1023 zsn = interp(k%I,k%J,jk,'U',1) 1024 zrhop = interp(k%I,k%J,jk,'U',2) 1025 zrhoi = interp(k%I,k%J,jk,'U',3) 1026 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1027 END SELECT 1028 1029 zfsdep= fsdept(k%I,k%J,jk) 1030 1031 !compute velocity with the correct direction 1032 SELECT CASE( sec%direction(jseg) ) 1033 CASE(0,1) 1034 zumid=0. 1035 zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk) 1036 CASE(2,3) 1037 zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk) 1038 zvmid=0. 1039 END SELECT 1040 1041 !zTnorm=transport through one cell; 1042 !velocity* cell's length * cell's thickness 1043 zTnorm=zumid*e2u(k%I,k%J)* fse3u(k%I,k%J,jk)+ & 1044 zvmid*e1v(k%I,k%J)* fse3v(k%I,k%J,jk) 840 1045 841 1046 #if ! defined key_vvl 842 !add transport due to free surface 843 IF( jk==1 )THEN 844 zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk) + & 845 zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk) 846 ENDIF 1047 !add transport due to free surface 1048 IF( jk==1 )THEN 1049 zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk) + & 1050 zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk) 1051 ENDIF 847 1052 #endif 848 1053 !COMPUTE TRANSPORT 849 850 transports_3d(1,jsec,jseg,jk) = transports_3d(1,jsec,jseg,jk) + zTnorm 851 852 IF ( sec%llstrpond ) THEN 853 transports_3d(2,jsec,jseg,jk) = transports_3d(2,jsec,jseg,jk) + zTnorm * z tn * zrhop * rcp854 transports_3d(3,jsec,jseg,jk) = transports_3d(3,jsec,jseg,jk) + zTnorm * z sn * zrhop * 0.0011054 1055 transports_3d(1,jsec,jseg,jk) = transports_3d(1,jsec,jseg,jk) + zTnorm 1056 1057 IF ( sec%llstrpond ) THEN 1058 transports_3d(2,jsec,jseg,jk) = transports_3d(2,jsec,jseg,jk) + zTnorm * zrhoi 1059 transports_3d(3,jsec,jseg,jk) = transports_3d(3,jsec,jseg,jk) + zTnorm * zrhop 855 1060 transports_3d(4,jsec,jseg,jk) = transports_3d(4,jsec,jseg,jk) + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp 856 1061 transports_3d(5,jsec,jseg,jk) = transports_3d(5,jsec,jseg,jk) + zTnorm * 0.001 * zsn * 1026._wp … … 880 1085 881 1086 zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J) 882 883 #if defined key_lim2 884 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* & 885 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & 886 *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) + & 887 hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) 888 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* & 889 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) 890 #endif 891 #if defined key_lim3 892 DO jl=1,jpl 893 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* & 894 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * & 895 ( ht_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) + & 896 ht_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) ) 897 898 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* & 899 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) 900 ENDDO 901 #endif 1087 1088 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* & 1089 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & 1090 *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) + & 1091 hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & 1092 +zice_vol_pos 1093 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* & 1094 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & 1095 +zice_surf_pos 902 1096 903 1097 ENDIF !end of ice case … … 957 1151 958 1152 !---------------------------------------------------------------------------------------------------- 1153 !---------------------------------------------------------------------------------------------------- 1154 !---------------------------------------------------------------------------------------------------- 1155 ! 1156 ! 1157 ! ! ! ! JT 1/09/2018 - changing convention. Always direction + is toward left hand of section 1158 ! 1159 ! Making sign of the velocities used to calculate the volume transport a function of direction, not slopesection 1160 ! (isgnu, isgnv) 1161 ! 1162 ! They vary for each segment of the section. 1163 ! 1164 !---------------------------------------------------------------------------------------------------- 1165 !---------------------------------------------------------------------------------------------------- 1166 !---------------------------------------------------------------------------------------------------- 959 1167 !Compute sign for velocities: 960 1168 ! … … 977 1185 ! 978 1186 !---------------------------------------------------------------------------------------------------- 979 isgnu = 1980 IF( sec%slopeSection .GT. 0 ) THEN ; isgnv = -1981 ELSE ; isgnv = 1982 ENDIF983 1187 984 1188 IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv … … 988 1192 !--------------------------------------! 989 1193 DO jseg=1,MAX(sec%nb_point-1,0) 990 1194 1195 1196 !Compute sign for velocities: 1197 1198 !isgnu = 1 1199 !isgnv = 1 1200 ! 1201 ! changing sign of u and v is dependent on the direction of the section. 1202 !isgnu = 1 1203 !isgnv = 1 1204 !SELECT CASE( sec%direction(jseg) ) 1205 !CASE(0) ; isgnv = -1 1206 !CASE(3) ; isgnu = -1 1207 !END SELECT 1208 1209 1210 SELECT CASE( sec%direction(jseg) ) 1211 CASE(0) 1212 isgnu = 1 1213 isgnv = -1 1214 CASE(1) 1215 isgnu = 1 1216 isgnv = 1 1217 CASE(2) 1218 isgnu = 1 1219 isgnv = 1 1220 CASE(3) 1221 isgnu = -1 1222 isgnv = 1 1223 END SELECT 1224 991 1225 !------------------------------------------------------------------------------------------- 992 1226 ! Select the appropriate coordinate for computing the velocity of the segment 1227 ! Corrected by JT 01/09/2018 (#) 993 1228 ! 994 1229 ! CASE(0) Case (2) 995 1230 ! ------- -------- 996 1231 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 997 ! F(i,j)--------- -V(i+1,j)-------F(i+1,j)|998 ! 999 ! 1000 ! 1001 ! Case (3) 1002 ! -------- 1003 ! 1232 ! F(i,j)---------#V(i,j)-------F(i+1,j) | 1233 ! --------> | 1234 ! | | 1235 ! | | 1236 ! Case (3) | U(i,j) 1237 ! -------- | | 1238 ! V | 1004 1239 ! listPoint(jseg+1) F(i,j+1) | 1005 1240 ! | | 1006 1241 ! | | 1007 1242 ! | listPoint(jseg+1) F(i,j-1) 1008 ! 1009 ! 1010 ! 1011 ! 1012 ! 1243 ! ^ | 1244 ! | | 1245 ! | U(i,j+1) 1246 ! | | Case(1) 1247 ! | | ------ 1013 1248 ! | 1014 1249 ! | listPoint(jseg+1) listPoint(jseg) 1015 ! | F(i-1,j)---------- -V(i,j) -------f(jseg)1016 ! listPoint(jseg) F(i,j) 1250 ! | F(i-1,j)----------#V(i-1,j) ------#f(i,j) 1251 ! listPoint(jseg) F(i,j) <------- 1017 1252 ! 1018 1253 !------------------------------------------------------------------------------------------- … … 1031 1266 DO jk=1,mbathy(k%I,k%J) 1032 1267 1033 ! compute temp arature, salinity, insitu & potential density, ssh and depth at U/V point1268 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 1034 1269 SELECT CASE( sec%direction(jseg) ) 1035 1270 CASE(0,1) 1036 ztn = interp(k%I,k%J,jk,'V',0 1271 ztn = interp(k%I,k%J,jk,'V',0) 1037 1272 zsn = interp(k%I,k%J,jk,'V',1) 1038 1273 zrhop = interp(k%I,k%J,jk,'V',2) … … 1151 1386 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point 1152 1387 !!------------------------------------------------------------- 1153 1154 !! Sum the relevant segments to obtain values for each class 1155 IF(sec%nb_point .NE. 0)THEN 1156 1157 !--------------------------------------! 1158 ! LOOP ON THE SEGMENT BETWEEN 2 NODES ! 1159 !--------------------------------------! 1160 DO jseg=1,MAX(sec%nb_point-1,0) 1161 1162 !------------------------------------------------------------------------------------------- 1163 ! Select the appropriate coordinate for computing the velocity of the segment 1164 ! 1165 ! CASE(0) Case (2) 1166 ! ------- -------- 1167 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 1168 ! F(i,j)----------V(i+1,j)-------F(i+1,j) | 1169 ! | 1170 ! | 1171 ! | 1172 ! Case (3) U(i,j) 1173 ! -------- | 1174 ! | 1175 ! listPoint(jseg+1) F(i,j+1) | 1176 ! | | 1177 ! | | 1178 ! | listPoint(jseg+1) F(i,j-1) 1179 ! | 1180 ! | 1181 ! U(i,j+1) 1182 ! | Case(1) 1183 ! | ------ 1184 ! | 1185 ! | listPoint(jseg+1) listPoint(jseg) 1186 ! | F(i-1,j)-----------V(i,j) -------f(jseg) 1187 ! listPoint(jseg) F(i,j) 1188 ! 1189 !------------------------------------------------------------------------------------------- 1190 1191 SELECT CASE( sec%direction(jseg) ) 1192 CASE(0) ; k = sec%listPoint(jseg) 1193 CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J) 1194 CASE(2) ; k = sec%listPoint(jseg) 1195 CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1) 1196 END SELECT 1197 1198 !---------------------------| 1199 ! LOOP ON THE LEVEL | 1200 !---------------------------| 1201 !Sum of the transport on the vertical 1202 DO jk=1,mbathy(k%I,k%J) 1203 1204 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 1205 SELECT CASE( sec%direction(jseg) ) 1206 CASE(0,1) 1207 ztn = interp(k%I,k%J,jk,'V',0 ) 1208 zsn = interp(k%I,k%J,jk,'V',1 ) 1209 zrhop = interp(k%I,k%J,jk,'V',2) 1210 zrhoi = interp(k%I,k%J,jk,'V',3) 1211 1212 CASE(2,3) 1213 ztn = interp(k%I,k%J,jk,'U',0 ) 1214 zsn = interp(k%I,k%J,jk,'U',1 ) 1215 zrhop = interp(k%I,k%J,jk,'U',2 ) 1216 zrhoi = interp(k%I,k%J,jk,'U',3 ) 1217 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1218 END SELECT 1219 1220 zfsdep= fsdept(k%I,k%J,jk) 1221 1222 !------------------------------- 1223 ! LOOP ON THE DENSITY CLASSES | 1224 !------------------------------- 1225 !The computation is made for each density/temperature/salinity/depth class 1226 DO jclass=1,MAX(1,sec%nb_class-1) 1227 1228 !----------------------------------------------! 1229 !TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL! 1230 !----------------------------------------------! 1231 1232 IF ( ( & 1233 ((( zrhop .GE. (sec%zsigp(jclass)+1000. )) .AND. & 1234 ( zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR. & 1235 ( sec%zsigp(jclass) .EQ. 99.)) .AND. & 1236 1237 ((( zrhoi .GE. (sec%zsigi(jclass) + 1000. )) .AND. & 1238 ( zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR. & 1239 ( sec%zsigi(jclass) .EQ. 99.)) .AND. & 1240 1241 ((( zsn .GT. sec%zsal(jclass)) .AND. & 1242 ( zsn .LE. sec%zsal(jclass+1))) .OR. & 1243 ( sec%zsal(jclass) .EQ. 99.)) .AND. & 1244 1245 ((( ztn .GE. sec%ztem(jclass)) .AND. & 1246 ( ztn .LE. sec%ztem(jclass+1))) .OR. & 1247 ( sec%ztem(jclass) .EQ.99.)) .AND. & 1248 1249 ((( zfsdep .GE. sec%zlay(jclass)) .AND. & 1250 ( zfsdep .LE. sec%zlay(jclass+1))) .OR. & 1251 ( sec%zlay(jclass) .EQ. 99. )) & 1252 )) THEN 1253 1254 !SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS 1255 !---------------------------------------------------------------------------- 1256 IF (transports_3d(1,jsec,jseg,jk) .GE. 0.0) THEN 1257 sec%transport(1,jclass) = sec%transport(1,jclass)+transports_3d(1,jsec,jseg,jk)*1.E-6 1258 ELSE 1259 sec%transport(2,jclass) = sec%transport(2,jclass)+transports_3d(1,jsec,jseg,jk)*1.E-6 1260 ENDIF 1261 IF( sec%llstrpond )THEN 1262 1263 IF ( transports_3d(2,jsec,jseg,jk) .GE. 0.0 ) THEN 1264 sec%transport(3,jclass) = sec%transport(3,jclass)+transports_3d(2,jsec,jseg,jk) 1265 ELSE 1266 sec%transport(4,jclass) = sec%transport(4,jclass)+transports_3d(2,jsec,jseg,jk) 1267 ENDIF 1268 1269 IF ( transports_3d(3,jsec,jseg,jk) .GE. 0.0 ) THEN 1270 sec%transport(5,jclass) = sec%transport(5,jclass)+transports_3d(3,jsec,jseg,jk) 1271 ELSE 1272 sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk) 1273 ENDIF 1274 1275 IF ( transports_3d(4,jsec,jseg,jk) .GE. 0.0 ) THEN 1276 sec%transport(7,jclass) = sec%transport(7,jclass)+transports_3d(4,jsec,jseg,jk) 1277 ELSE 1278 sec%transport(8,jclass) = sec%transport(8,jclass)+transports_3d(4,jsec,jseg,jk) 1279 ENDIF 1280 1281 IF ( transports_3d(5,jsec,jseg,jk) .GE. 0.0 ) THEN 1282 sec%transport( 9,jclass) = sec%transport( 9,jclass)+transports_3d(5,jsec,jseg,jk) 1283 ELSE 1284 sec%transport(10,jclass) = sec%transport(10,jclass)+transports_3d(5,jsec,jseg,jk) 1285 ENDIF 1286 1287 ELSE 1288 sec%transport( 3,jclass) = 0._wp 1289 sec%transport( 4,jclass) = 0._wp 1290 sec%transport( 5,jclass) = 0._wp 1291 sec%transport( 6,jclass) = 0._wp 1292 sec%transport( 7,jclass) = 0._wp 1293 sec%transport( 8,jclass) = 0._wp 1294 sec%transport( 9,jclass) = 0._wp 1295 sec%transport(10,jclass) = 0._wp 1296 ENDIF 1297 1298 ENDIF ! end of test if point is in class 1299 1300 ENDDO ! end of loop on the classes 1301 1302 ENDDO ! loop over jk 1303 1304 #if defined key_lim2 || defined key_lim3 1305 1306 !ICE CASE 1307 IF( sec%ll_ice_section )THEN 1308 1309 IF ( transports_2d(1,jsec,jseg) .GE. 0.0 ) THEN 1310 sec%transport(11,1) = sec%transport(11,1)+transports_2d(1,jsec,jseg)*1.E-6 1311 ELSE 1312 sec%transport(12,1) = sec%transport(12,1)+transports_2d(1,jsec,jseg)*1.E-6 1313 ENDIF 1314 1315 IF ( transports_2d(3,jsec,jseg) .GE. 0.0 ) THEN 1316 sec%transport(13,1) = sec%transport(13,1)+transports_2d(2,jsec,jseg)*1.E-6 1317 ELSE 1318 sec%transport(14,1) = sec%transport(14,1)+transports_2d(2,jsec,jseg)*1.E-6 1319 ENDIF 1320 1321 ENDIF !end of ice case 1322 #endif 1323 1324 ENDDO !end of loop on the segment 1325 1326 ELSE !if sec%nb_point =0 1327 sec%transport(1:2,:)=0. 1328 IF (sec%llstrpond) sec%transport(3:10,:)=0. 1329 IF (sec%ll_ice_section) sec%transport(11:14,:)=0. 1330 ENDIF !end of sec%nb_point =0 case 1331 1332 END SUBROUTINE dia_dct_sum 1333 1334 SUBROUTINE dia_dct_sum_h(sec,jsec) 1335 !!------------------------------------------------------------- 1336 !! Exactly as dia_dct_sum but for hourly files containing data summed at each time step 1337 !! 1338 !! Purpose: Average the transport over nn_dctwri time steps 1339 !! and sum over the density/salinity/temperature/depth classes 1340 !! 1341 !! Method: 1342 !! Sum over relevant grid cells to obtain values 1343 !! for each 1344 !! There are several loops: 1345 !! loop on the segment between 2 nodes 1346 !! loop on the level jk 1347 !! loop on the density/temperature/salinity/level classes 1348 !! test on the density/temperature/salinity/level 1349 !! 1350 !! ** Method :Transport through a given section is equal to the sum of transports 1351 !! computed on each proc. 1352 !! On each proc,transport is equal to the sum of transport computed through 1353 !! segments linking each point of sec%listPoint with the next one. 1354 !! 1355 !!------------------------------------------------------------- 1356 !! * arguments 1357 TYPE(SECTION),INTENT(INOUT) :: sec 1358 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section 1359 1360 TYPE(POINT_SECTION) :: k 1361 INTEGER :: jk,jseg,jclass !loop on level/segment/classes 1362 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point 1363 !!------------------------------------------------------------- 1388 1364 1389 1365 1390 !! Sum the relevant segments to obtain values for each class … … 1416 1441 SELECT CASE( sec%direction(jseg) ) 1417 1442 CASE(0,1) 1418 ztn = interp(k%I,k%J,jk,'V',0 1419 zsn = interp(k%I,k%J,jk,'V',1 1420 zrhop = interp(k%I,k%J,jk,'V',2 1421 zrhoi = interp(k%I,k%J,jk,'V',3 1443 ztn = interp(k%I,k%J,jk,'V',0) 1444 zsn = interp(k%I,k%J,jk,'V',1) 1445 zrhop = interp(k%I,k%J,jk,'V',2) 1446 zrhoi = interp(k%I,k%J,jk,'V',3) 1422 1447 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 1423 1448 CASE(2,3) 1424 ztn = interp(k%I,k%J,jk,'U',0 ) 1425 zsn = interp(k%I,k%J,jk,'U',1 ) 1426 zrhop = interp(k%I,k%J,jk,'U',2 ) 1427 zrhoi = interp(k%I,k%J,jk,'U',3 ) 1449 ztn = interp(k%I,k%J,jk,'U',0) 1450 zsn = interp(k%I,k%J,jk,'U',1) 1451 zrhop = interp(k%I,k%J,jk,'U',2) 1452 zrhoi = interp(k%I,k%J,jk,'U',3) 1453 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1454 END SELECT 1455 1456 zfsdep= fsdept(k%I,k%J,jk) 1457 1458 !------------------------------- 1459 ! LOOP ON THE DENSITY CLASSES | 1460 !------------------------------- 1461 !The computation is made for each density/temperature/salinity/depth class 1462 DO jclass=1,MAX(1,sec%nb_class-1) 1463 1464 !----------------------------------------------! 1465 !TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL! 1466 !----------------------------------------------! 1467 1468 IF ( ( & 1469 ((( zrhop .GE. (sec%zsigp(jclass)+1000. )) .AND. & 1470 ( zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR. & 1471 ( sec%zsigp(jclass) .EQ. 99.)) .AND. & 1472 1473 ((( zrhoi .GE. (sec%zsigi(jclass) + 1000. )) .AND. & 1474 ( zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR. & 1475 ( sec%zsigi(jclass) .EQ. 99.)) .AND. & 1476 1477 ((( zsn .GT. sec%zsal(jclass)) .AND. & 1478 ( zsn .LE. sec%zsal(jclass+1))) .OR. & 1479 ( sec%zsal(jclass) .EQ. 99.)) .AND. & 1480 1481 ((( ztn .GE. sec%ztem(jclass)) .AND. & 1482 ( ztn .LE. sec%ztem(jclass+1))) .OR. & 1483 ( sec%ztem(jclass) .EQ.99.)) .AND. & 1484 1485 ((( zfsdep .GE. sec%zlay(jclass)) .AND. & 1486 ( zfsdep .LE. sec%zlay(jclass+1))) .OR. & 1487 ( sec%zlay(jclass) .EQ. 99. )) & 1488 )) THEN 1489 1490 !SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS 1491 !---------------------------------------------------------------------------- 1492 IF (transports_3d(1,jsec,jseg,jk) .GE. 0.0) THEN 1493 sec%transport(1,jclass) = sec%transport(1,jclass)+transports_3d(1,jsec,jseg,jk) 1494 ELSE 1495 sec%transport(2,jclass) = sec%transport(2,jclass)+transports_3d(1,jsec,jseg,jk) 1496 ENDIF 1497 IF( sec%llstrpond )THEN 1498 1499 IF( transports_3d(1,jsec,jseg,jk) .NE. 0._wp ) THEN 1500 1501 IF (transports_3d(2,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) .GE. 0.0 ) THEN 1502 sec%transport(3,jclass) = sec%transport(3,jclass)+transports_3d(2,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) 1503 ELSE 1504 sec%transport(4,jclass) = sec%transport(4,jclass)+transports_3d(2,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) 1505 ENDIF 1506 1507 IF ( transports_3d(3,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) .GE. 0.0 ) THEN 1508 sec%transport(5,jclass) = sec%transport(5,jclass)+transports_3d(3,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) 1509 ELSE 1510 sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) 1511 ENDIF 1512 1513 ENDIF 1514 1515 IF ( transports_3d(4,jsec,jseg,jk) .GE. 0.0 ) THEN 1516 sec%transport(7,jclass) = sec%transport(7,jclass)+transports_3d(4,jsec,jseg,jk) 1517 ELSE 1518 sec%transport(8,jclass) = sec%transport(8,jclass)+transports_3d(4,jsec,jseg,jk) 1519 ENDIF 1520 1521 IF ( transports_3d(5,jsec,jseg,jk) .GE. 0.0 ) THEN 1522 sec%transport( 9,jclass) = sec%transport( 9,jclass)+transports_3d(5,jsec,jseg,jk) 1523 ELSE 1524 sec%transport(10,jclass) = sec%transport(10,jclass)+transports_3d(5,jsec,jseg,jk) 1525 ENDIF 1526 1527 ELSE 1528 sec%transport( 3,jclass) = 0._wp 1529 sec%transport( 4,jclass) = 0._wp 1530 sec%transport( 5,jclass) = 0._wp 1531 sec%transport( 6,jclass) = 0._wp 1532 sec%transport( 7,jclass) = 0._wp 1533 sec%transport( 8,jclass) = 0._wp 1534 sec%transport( 9,jclass) = 0._wp 1535 sec%transport(10,jclass) = 0._wp 1536 ENDIF 1537 1538 ENDIF ! end of test if point is in class 1539 1540 ENDDO ! end of loop on the classes 1541 1542 ENDDO ! loop over jk 1543 1544 #if defined key_lim2 || defined key_lim3 1545 1546 !ICE CASE 1547 IF( sec%ll_ice_section )THEN 1548 1549 IF ( transports_2d(1,jsec,jseg) .GE. 0.0 ) THEN 1550 sec%transport(11,1) = sec%transport(11,1)+transports_2d(1,jsec,jseg) 1551 ELSE 1552 sec%transport(12,1) = sec%transport(12,1)+transports_2d(1,jsec,jseg) 1553 ENDIF 1554 1555 IF ( transports_2d(3,jsec,jseg) .GE. 0.0 ) THEN 1556 sec%transport(13,1) = sec%transport(13,1)+transports_2d(2,jsec,jseg) 1557 ELSE 1558 sec%transport(14,1) = sec%transport(14,1)+transports_2d(2,jsec,jseg) 1559 ENDIF 1560 1561 ENDIF !end of ice case 1562 #endif 1563 1564 ENDDO !end of loop on the segment 1565 1566 ELSE !if sec%nb_point =0 1567 sec%transport(1:2,:)=0. 1568 IF (sec%llstrpond) sec%transport(3:10,:)=0. 1569 IF (sec%ll_ice_section) sec%transport( 11:14,:)=0. 1570 ENDIF !end of sec%nb_point =0 case 1571 1572 END SUBROUTINE dia_dct_sum 1573 1574 SUBROUTINE dia_dct_sum_h(sec,jsec) 1575 !!------------------------------------------------------------- 1576 !! Exactly as dia_dct_sum but for hourly files containing data summed at each time step 1577 !! 1578 !! Purpose: Average the transport over nn_dctwri time steps 1579 !! and sum over the density/salinity/temperature/depth classes 1580 !! 1581 !! Method: 1582 !! Sum over relevant grid cells to obtain values 1583 !! for each 1584 !! There are several loops: 1585 !! loop on the segment between 2 nodes 1586 !! loop on the level jk 1587 !! loop on the density/temperature/salinity/level classes 1588 !! test on the density/temperature/salinity/level 1589 !! 1590 !! ** Method :Transport through a given section is equal to the sum of transports 1591 !! computed on each proc. 1592 !! On each proc,transport is equal to the sum of transport computed through 1593 !! segments linking each point of sec%listPoint with the next one. 1594 !! 1595 !!------------------------------------------------------------- 1596 !! * arguments 1597 TYPE(SECTION),INTENT(INOUT) :: sec 1598 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section 1599 1600 TYPE(POINT_SECTION) :: k 1601 INTEGER :: jk,jseg,jclass !loop on level/segment/classes 1602 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point 1603 !!------------------------------------------------------------- 1604 1605 !! Sum the relevant segments to obtain values for each class 1606 IF(sec%nb_point .NE. 0)THEN 1607 1608 !--------------------------------------! 1609 ! LOOP ON THE SEGMENT BETWEEN 2 NODES ! 1610 !--------------------------------------! 1611 DO jseg=1,MAX(sec%nb_point-1,0) 1612 1613 !------------------------------------------------------------------------------------------- 1614 ! Select the appropriate coordinate for computing the velocity of the segment 1615 ! 1616 ! CASE(0) Case (2) 1617 ! ------- -------- 1618 ! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j) 1619 ! F(i,j)----------V(i+1,j)-------F(i+1,j) | 1620 ! | 1621 ! | 1622 ! | 1623 ! Case (3) U(i,j) 1624 ! -------- | 1625 ! | 1626 ! listPoint(jseg+1) F(i,j+1) | 1627 ! | | 1628 ! | | 1629 ! | listPoint(jseg+1) F(i,j-1) 1630 ! | 1631 ! | 1632 ! U(i,j+1) 1633 ! | Case(1) 1634 ! | ------ 1635 ! | 1636 ! | listPoint(jseg+1) listPoint(jseg) 1637 ! | F(i-1,j)-----------V(i,j) -------f(jseg) 1638 ! listPoint(jseg) F(i,j) 1639 ! 1640 !------------------------------------------------------------------------------------------- 1641 1642 SELECT CASE( sec%direction(jseg) ) 1643 CASE(0) ; k = sec%listPoint(jseg) 1644 CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J) 1645 CASE(2) ; k = sec%listPoint(jseg) 1646 CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1) 1647 END SELECT 1648 1649 !---------------------------| 1650 ! LOOP ON THE LEVEL | 1651 !---------------------------| 1652 !Sum of the transport on the vertical 1653 DO jk=1,mbathy(k%I,k%J) 1654 1655 ! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point 1656 SELECT CASE( sec%direction(jseg) ) 1657 CASE(0,1) 1658 ztn = interp(k%I,k%J,jk,'V',0) 1659 zsn = interp(k%I,k%J,jk,'V',1) 1660 zrhop = interp(k%I,k%J,jk,'V',2) 1661 zrhoi = interp(k%I,k%J,jk,'V',3) 1662 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1) 1663 CASE(2,3) 1664 ztn = interp(k%I,k%J,jk,'U',0) 1665 zsn = interp(k%I,k%J,jk,'U',1) 1666 zrhop = interp(k%I,k%J,jk,'U',2) 1667 zrhoi = interp(k%I,k%J,jk,'U',3) 1428 1668 zsshn = 0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1) 1429 1669 END SELECT … … 1472 1712 IF( sec%llstrpond )THEN 1473 1713 1474 IF ( transports_3d_h(2,jsec,jseg,jk) .GE. 0.0 ) THEN 1475 sec%transport_h(3,jclass) = sec%transport_h(3,jclass)+transports_3d_h(2,jsec,jseg,jk) 1476 ELSE 1477 sec%transport_h(4,jclass) = sec%transport_h(4,jclass)+transports_3d_h(2,jsec,jseg,jk) 1478 ENDIF 1479 1480 IF ( transports_3d_h(3,jsec,jseg,jk) .GE. 0.0 ) THEN 1481 sec%transport_h(5,jclass) = sec%transport_h(5,jclass)+transports_3d_h(3,jsec,jseg,jk) 1482 ELSE 1483 sec%transport_h(6,jclass) = sec%transport_h(6,jclass)+transports_3d_h(3,jsec,jseg,jk) 1484 ENDIF 1714 IF( transports_3d_h(1,jsec,jseg,jk) .NE. 0._wp ) THEN 1715 1716 IF (transports_3d_h(2,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) .GE. 0.0 ) THEN 1717 sec%transport_h(3,jclass) = sec%transport_h(3,jclass)+transports_3d_h(2,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) 1718 ELSE 1719 sec%transport_h(4,jclass) = sec%transport_h(4,jclass)+transports_3d_h(2,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) 1720 ENDIF 1721 1722 IF ( transports_3d_h(3,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) .GE. 0.0 ) THEN 1723 sec%transport_h(5,jclass) = sec%transport_h(5,jclass)+transports_3d_h(3,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) 1724 ELSE 1725 sec%transport_h(6,jclass) = sec%transport_h(6,jclass)+transports_3d_h(3,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) 1726 ENDIF 1727 1728 ENDIF 1485 1729 1486 1730 IF ( transports_3d_h(4,jsec,jseg,jk) .GE. 0.0 ) THEN … … 1572 1816 ! 1573 1817 REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 1818 CHARACTER(len=3) :: noos_sect_name ! Classname 1819 CHARACTER(len=25) :: noos_var_sect_name 1820 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: noos_iom_dummy 1821 INTEGER :: IERR 1822 1823 REAL(wp), DIMENSION(3) :: tmp_iom_output 1824 REAL(wp) :: max_iom_val 1825 1574 1826 !!------------------------------------------------------------- 1827 1828 1829 1830 IF( lwp ) THEN 1831 WRITE(numout,*) " " 1832 WRITE(numout,*) "dia_dct_wri_NOOS: write transports through sections at timestep: ", kt 1833 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 1834 ENDIF 1835 1575 1836 CALL wrk_alloc(nb_type_class , zsumclasses ) 1576 1837 1577 1838 zsumclasses(:)=0._wp 1578 1839 zslope = sec%slopeSection 1579 1580 WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1,' Name: ',sec%name 1581 1840 1841 IF( lwp ) THEN 1842 IF ( ln_dct_ascii ) THEN 1843 WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1,' Name: ',sec%name 1844 ELSE 1845 WRITE(numdct_NOOS) nyear,nmonth,nday,ksec-1,sec%nb_class-1,sec%name 1846 ENDIF 1847 ENDIF 1848 1849 ! Sum all classes together, to give one values per type (pos tran, neg vol trans etc...). 1582 1850 DO jclass=1,MAX(1,sec%nb_class-1) 1583 1851 zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass) … … 1587 1855 zbnd1 = 0._wp 1588 1856 zbnd2 = 0._wp 1589 1590 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1591 WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1), & 1592 -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7), & 1593 -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9) 1594 ELSE 1595 WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 1596 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 1597 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 1598 ENDIF 1857 1858 1859 1860 write (noos_sect_name, "(I0.3)") ksec 1861 1862 IF ( ln_dct_iom_cont ) THEN 1863 max_iom_val = 1.e10 1864 ALLOCATE( noos_iom_dummy(jpi,jpj,3), STAT= ierr ) 1865 IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS: failed to allocate noos_iom_dummy array' ) 1866 ENDIF 1867 1868 ! JT I think changing the sign on the output based on the zslope value is redunant. 1869 ! 1870 ! IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1871 ! 1872 ! IF( lwp ) THEN 1873 ! WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1), & 1874 ! -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7), & 1875 ! -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9) 1876 ! CALL FLUSH(numdct_NOOS) 1877 ! endif 1878 1879 ! 1880 ! IF ( ln_dct_iom_cont ) THEN 1881 ! 1882 ! noos_iom_dummy(:,:,:) = 0. 1883 ! 1884 ! tmp_iom_output(:) = 0. 1885 ! tmp_iom_output(1) = -(zsumclasses( 1)+zsumclasses( 2)) 1886 ! tmp_iom_output(2) = -zsumclasses( 2) 1887 ! tmp_iom_output(3) = -zsumclasses( 1) 1888 ! 1889 ! ! Convert to Sv 1890 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 1891 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 1892 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 1893 ! 1894 ! ! limit maximum and minimum values in iom_put 1895 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 1896 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 1897 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 1898 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 1899 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 1900 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 1901 ! 1902 ! ! Set NaN's to Zero 1903 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 1904 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 1905 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 1906 ! 1907 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 1908 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 1909 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 1910 ! 1911 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans' 1912 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1913 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1914 ! noos_iom_dummy(:,:,:) = 0. 1915 ! tmp_iom_output(:) = 0. 1916 ! tmp_iom_output(1) = -(zsumclasses( 7)+zsumclasses( 8)) 1917 ! tmp_iom_output(2) = -zsumclasses( 8) 1918 ! tmp_iom_output(3) = -zsumclasses( 7) 1919 ! 1920 ! ! Convert to TJ/s 1921 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-12 1922 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-12 1923 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-12 1924 ! 1925 ! ! limit maximum and minimum values in iom_put 1926 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 1927 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 1928 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 1929 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 1930 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 1931 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 1932 ! 1933 ! ! Set NaN's to Zero 1934 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 1935 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 1936 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 1937 ! 1938 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 1939 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 1940 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 1941 ! 1942 ! !noos_iom_dummy(:,:,1) = -(zsumclasses( 7)+zsumclasses( 8)) 1943 ! !noos_iom_dummy(:,:,2) = -zsumclasses( 8) 1944 ! !noos_iom_dummy(:,:,3) = -zsumclasses( 7) 1945 ! 1946 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat' 1947 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1948 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1949 ! 1950 ! noos_iom_dummy(:,:,:) = 0. 1951 ! tmp_iom_output(:) = 0. 1952 ! tmp_iom_output(1) = -(zsumclasses( 9)+zsumclasses( 10)) 1953 ! tmp_iom_output(2) = -zsumclasses( 10) 1954 ! tmp_iom_output(3) = -zsumclasses( 9) 1955 ! 1956 ! ! Convert to MT/s 1957 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 1958 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 1959 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 1960 ! 1961 ! ! limit maximum and minimum values in iom_put 1962 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 1963 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 1964 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 1965 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 1966 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 1967 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 1968 ! 1969 ! ! Set NaN's to Zero 1970 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 1971 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 1972 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 1973 ! 1974 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 1975 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 1976 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 1977 ! 1978 ! !noos_iom_dummy(:,:,1) = -(zsumclasses( 9)+zsumclasses( 10)) 1979 ! !noos_iom_dummy(:,:,2) = -zsumclasses( 10) 1980 ! !noos_iom_dummy(:,:,3) = -zsumclasses( 9) 1981 ! 1982 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt' 1983 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 1984 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 1985 ! noos_iom_dummy(:,:,:) = 0. 1986 ! tmp_iom_output(:) = 0. 1987 ! ENDIF 1988 ! ELSE 1989 ! IF( lwp ) THEN 1990 ! WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 1991 ! zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 1992 ! zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 1993 ! CALL FLUSH(numdct_NOOS) 1994 ! endif 1995 ! 1996 ! 1997 ! IF ( ln_dct_iom_cont ) THEN 1998 ! 1999 ! noos_iom_dummy(:,:,:) = 0. 2000 ! tmp_iom_output(:) = 0. 2001 ! 2002 ! tmp_iom_output(1) = (zsumclasses( 1)+zsumclasses( 2)) 2003 ! tmp_iom_output(2) = zsumclasses( 1) 2004 ! tmp_iom_output(3) = zsumclasses( 2) 2005 ! 2006 ! ! Convert to Sv 2007 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2008 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2009 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2010 ! 2011 ! ! limit maximum and minimum values in iom_put 2012 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2013 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2014 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2015 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2016 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2017 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2018 ! 2019 ! ! Set NaN's to Zero 2020 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2021 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2022 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2023 ! 2024 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2025 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2026 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2027 ! 2028 ! !noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2)) 2029 ! !noos_iom_dummy(:,:,2) = zsumclasses( 1) 2030 ! !noos_iom_dummy(:,:,3) = zsumclasses( 2) 2031 ! 2032 ! 2033 ! 2034 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans' 2035 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2036 ! CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 2037 ! noos_iom_dummy(:,:,:) = 0. 2038 ! tmp_iom_output(:) = 0. 2039 ! 2040 ! tmp_iom_output(1) = (zsumclasses( 7)+zsumclasses( 8)) 2041 ! tmp_iom_output(2) = zsumclasses( 7) 2042 ! tmp_iom_output(3) = zsumclasses( 8) 2043 ! 2044 ! ! Convert to TJ/s 2045 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-12 2046 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-12 2047 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-12 2048 ! 2049 ! ! limit maximum and minimum values in iom_put 2050 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2051 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2052 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2053 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2054 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2055 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2056 ! 2057 ! ! Set NaN's to Zero 2058 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2059 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2060 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2061 ! 2062 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2063 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2064 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2065 ! 2066 ! !noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8)) 2067 ! !noos_iom_dummy(:,:,2) = zsumclasses( 7) 2068 ! !noos_iom_dummy(:,:,3) = zsumclasses( 8) 2069 ! 2070 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat' 2071 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2072 ! CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 2073 ! noos_iom_dummy(:,:,:) = 0. 2074 ! tmp_iom_output(:) = 0. 2075 ! 2076 ! tmp_iom_output(1) = (zsumclasses( 9)+zsumclasses( 10)) 2077 ! tmp_iom_output(2) = zsumclasses( 9) 2078 ! tmp_iom_output(3) = zsumclasses( 10) 2079 ! 2080 ! ! Convert to MT/s 2081 ! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2082 ! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2083 ! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2084 ! 2085 ! 2086 ! ! limit maximum and minimum values in iom_put 2087 ! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2088 ! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2089 ! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2090 ! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2091 ! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2092 ! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2093 ! 2094 ! ! Set NaN's to Zero 2095 ! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2096 ! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2097 ! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2098 ! 2099 ! noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2100 ! noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2101 ! noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2102 ! 2103 ! !noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10)) 2104 ! !noos_iom_dummy(:,:,2) = zsumclasses( 9) 2105 ! !noos_iom_dummy(:,:,3) = zsumclasses( 10) 2106 ! 2107 ! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt' 2108 ! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2109 ! CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 2110 ! noos_iom_dummy(:,:,:) = 0. 2111 ! tmp_iom_output(:) = 0. 2112 ! ENDIF 2113 ! 2114 ! ENDIF 2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 IF( lwp ) THEN 2126 IF ( ln_dct_ascii ) THEN 2127 !WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 2128 WRITE(numdct_NOOS,'(3F18.3,6e16.8E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 2129 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 2130 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 2131 CALL FLUSH(numdct_NOOS) 2132 ELSE 2133 WRITE(numdct_NOOS) zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), & 2134 zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), & 2135 zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10) 2136 CALL FLUSH(numdct_NOOS) 2137 ENDIF 2138 ENDIF 2139 2140 IF ( ln_dct_iom_cont ) THEN 2141 2142 noos_iom_dummy(:,:,:) = 0. 2143 tmp_iom_output(:) = 0. 2144 2145 tmp_iom_output(1) = (zsumclasses( 1)+zsumclasses( 2)) 2146 tmp_iom_output(2) = zsumclasses( 1) 2147 tmp_iom_output(3) = zsumclasses( 2) 2148 2149 ! Convert to Sv 2150 tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2151 tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2152 tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2153 2154 ! limit maximum and minimum values in iom_put 2155 if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2156 if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2157 if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2158 if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2159 if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2160 if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2161 2162 ! Set NaN's to Zero 2163 if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2164 if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2165 if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2166 2167 noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2168 noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2169 noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2170 2171 !noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2)) 2172 !noos_iom_dummy(:,:,2) = zsumclasses( 1) 2173 !noos_iom_dummy(:,:,3) = zsumclasses( 2) 2174 2175 2176 2177 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans' 2178 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2179 CALL iom_put( noos_var_sect_name, noos_iom_dummy ) 2180 noos_iom_dummy(:,:,:) = 0. 2181 tmp_iom_output(:) = 0. 2182 2183 tmp_iom_output(1) = (zsumclasses( 7)+zsumclasses( 8)) 2184 tmp_iom_output(2) = zsumclasses( 7) 2185 tmp_iom_output(3) = zsumclasses( 8) 2186 2187 ! Convert to TJ/s 2188 tmp_iom_output(1) = tmp_iom_output(1)*1.E-12 2189 tmp_iom_output(2) = tmp_iom_output(2)*1.E-12 2190 tmp_iom_output(3) = tmp_iom_output(3)*1.E-12 2191 2192 ! limit maximum and minimum values in iom_put 2193 if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2194 if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2195 if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2196 if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2197 if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2198 if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2199 2200 ! Set NaN's to Zero 2201 if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2202 if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2203 if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2204 2205 noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2206 noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2207 noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2208 2209 !noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8)) 2210 !noos_iom_dummy(:,:,2) = zsumclasses( 7) 2211 !noos_iom_dummy(:,:,3) = zsumclasses( 8) 2212 2213 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat' 2214 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2215 CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 2216 noos_iom_dummy(:,:,:) = 0. 2217 tmp_iom_output(:) = 0. 2218 2219 tmp_iom_output(1) = (zsumclasses( 9)+zsumclasses( 10)) 2220 tmp_iom_output(2) = zsumclasses( 9) 2221 tmp_iom_output(3) = zsumclasses( 10) 2222 2223 ! Convert to MT/s 2224 tmp_iom_output(1) = tmp_iom_output(1)*1.E-6 2225 tmp_iom_output(2) = tmp_iom_output(2)*1.E-6 2226 tmp_iom_output(3) = tmp_iom_output(3)*1.E-6 2227 2228 2229 ! limit maximum and minimum values in iom_put 2230 if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val 2231 if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val 2232 if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val 2233 if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val 2234 if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val 2235 if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val 2236 2237 ! Set NaN's to Zero 2238 if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2 2239 if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2 2240 if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2 2241 2242 noos_iom_dummy(:,:,1) = tmp_iom_output(1) 2243 noos_iom_dummy(:,:,2) = tmp_iom_output(2) 2244 noos_iom_dummy(:,:,3) = tmp_iom_output(3) 2245 2246 !noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10)) 2247 !noos_iom_dummy(:,:,2) = zsumclasses( 9) 2248 !noos_iom_dummy(:,:,3) = zsumclasses( 10) 2249 2250 noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt' 2251 if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name 2252 CALL iom_put(noos_var_sect_name, noos_iom_dummy ) 2253 noos_iom_dummy(:,:,:) = 0. 2254 tmp_iom_output(:) = 0. 2255 2256 2257 DEALLOCATE(noos_iom_dummy) 2258 ENDIF 2259 1599 2260 1600 2261 DO jclass=1,MAX(1,sec%nb_class-1) … … 1641 2302 1642 2303 !write volume transport per class 1643 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1644 WRITE(numdct_NOOS,'(9e12.4E2)') -(sec%transport( 1,jclass)+sec%transport( 2,jclass)),-sec%transport( 2,jclass),-sec%transport( 1,jclass), & 1645 -(sec%transport( 7,jclass)+sec%transport( 8,jclass)),-sec%transport( 8,jclass),-sec%transport( 7,jclass), & 1646 -(sec%transport( 9,jclass)+sec%transport(10,jclass)),-sec%transport(10,jclass),-sec%transport( 9,jclass) 1647 ELSE 1648 WRITE(numdct_NOOS,'(9e12.4E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 1649 sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 1650 sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 2304 IF( lwp ) THEN 2305 2306 IF ( ln_dct_ascii ) THEN 2307 CALL FLUSH(numdct_NOOS) 2308 2309 !WRITE(numdct_NOOS,'(9e12.4E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 2310 ! sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 2311 ! sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 2312 WRITE(numdct_NOOS,'(3F18.3,6e16.8E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 2313 sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 2314 sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 2315 ELSE 2316 2317 CALL FLUSH(numdct_NOOS) 2318 WRITE(numdct_NOOS) sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), & 2319 sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), & 2320 sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass) 2321 ENDIF 1651 2322 ENDIF 1652 2323 1653 2324 ENDDO 2325 2326 !IF ( ln_dct_ascii ) THEN 2327 if ( lwp ) CALL FLUSH(numdct_NOOS) 2328 !ENDIF 1654 2329 1655 2330 CALL wrk_dealloc(nb_type_class , zsumclasses ) … … 1671 2346 !!------------------------------------------------------------- 1672 2347 !!arguments 1673 INTEGER, INTENT(IN) :: hr ! hour 2348 INTEGER, INTENT(IN) :: hr ! hour => effectively kt/12 1674 2349 TYPE(SECTION), INTENT(INOUT) :: sec ! section to write 1675 2350 INTEGER ,INTENT(IN) :: ksec ! section number … … 1682 2357 ! 1683 2358 REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace 2359 CHARACTER(len=3) :: noos_sect_name ! Classname 2360 CHARACTER(len=25) :: noos_var_sect_name 2361 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: noos_iom_dummy 2362 INTEGER :: IERR 2363 1684 2364 !!------------------------------------------------------------- 1685 2365 2366 IF( lwp ) THEN 2367 WRITE(numout,*) " " 2368 WRITE(numout,*) "dia_dct_wri_NOOS_h: write transports through section Transect:",ksec-1," at timestep: ", hr 2369 WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 2370 ENDIF 2371 1686 2372 CALL wrk_alloc(nb_type_class , zsumclasses ) 2373 2374 2375 write (noos_sect_name, "(I03)") ksec 2376 2377 ALLOCATE( noos_iom_dummy(jpi,jpj,3), STAT= ierr ) 2378 IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS_h: failed to allocate noos_iom_dummy array' ) 2379 2380 2381 2382 1687 2383 1688 2384 zsumclasses(:)=0._wp 1689 2385 zslope = sec%slopeSection 1690 2386 2387 ! Sum up all classes, to give the total per type (pos vol trans, neg vol trans etc...) 1691 2388 DO jclass=1,MAX(1,sec%nb_class-1) 1692 2389 zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport_h(1:nb_type_class,jclass) 1693 2390 ENDDO 1694 2391 2392 2393 ! JT I think changing the sign of output according to the zslope is redundant 2394 1695 2395 !write volume transport per class 1696 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1697 z_hr_output(ksec,hr,1)=-(zsumclasses(1)+zsumclasses(2)) 1698 ELSE 1699 z_hr_output(ksec,hr,1)= (zsumclasses(1)+zsumclasses(2)) 1700 ENDIF 1701 2396 ! Sum positive and vol trans for all classes in first cell of array 2397 2398 z_hr_output(ksec,1,1)= (zsumclasses(1)+zsumclasses(2)) 2399 z_hr_output(ksec,2,1)= zsumclasses(1) 2400 z_hr_output(ksec,3,1)= zsumclasses(2) 2401 2402 ! Sum positive and vol trans for each classes in following cell of array 1702 2403 DO jclass=1,MAX(1,sec%nb_class-1) 1703 IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN 1704 z_hr_output(ksec,hr,jclass+1)=-(sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2404 z_hr_output(ksec,1,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2405 z_hr_output(ksec,2,jclass+1)= sec%transport_h(1,jclass) 2406 z_hr_output(ksec,3,jclass+1)= sec%transport_h(2,jclass) 2407 ENDDO 2408 2409 2410 IF( lwp ) THEN 2411 ! JT IF ( hr .eq. 48._wp ) THEN 2412 ! JT WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1 2413 ! JT DO jhr=25,48 2414 ! JT WRITE(numdct_NOOS_h,'(11F12.1)') z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) ) 2415 ! JT ENDDO 2416 ! JT ENDIF 2417 2418 2419 2420 IF ( ln_dct_ascii ) THEN 2421 WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,'.',MOD(hr,24),'.',0,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1 2422 WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,1,1), (z_hr_output(ksec,1,jclass+1), jclass=1,MAX(1,10) ) 2423 WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,2,1), (z_hr_output(ksec,2,jclass+1), jclass=1,MAX(1,10) ) 2424 WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,3,1), (z_hr_output(ksec,3,jclass+1), jclass=1,MAX(1,10) ) 2425 CALL FLUSH(numdct_NOOS_h) 1705 2426 ELSE 1706 z_hr_output(ksec,hr,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass)) 2427 WRITE(numdct_NOOS_h) nyear,nmonth,nday,MOD(hr,24),ksec-1,sec%nb_class-1 2428 WRITE(numdct_NOOS_h) z_hr_output(ksec,1,1), (z_hr_output(ksec,1,jclass+1), jclass=1,MAX(1,10) ) 2429 WRITE(numdct_NOOS_h) z_hr_output(ksec,2,1), (z_hr_output(ksec,2,jclass+1), jclass=1,MAX(1,10) ) 2430 WRITE(numdct_NOOS_h) z_hr_output(ksec,3,1), (z_hr_output(ksec,3,jclass+1), jclass=1,MAX(1,10) ) 2431 CALL FLUSH(numdct_NOOS_h) 1707 2432 ENDIF 1708 ENDDO 1709 1710 IF ( hr .eq. 48._wp ) THEN 1711 WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1 1712 DO jhr=25,48 1713 WRITE(numdct_NOOS_h,'(11F12.1)') z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) ) 1714 ENDDO 1715 ENDIF 2433 2434 2435 ENDIF 2436 1716 2437 1717 2438 CALL wrk_dealloc(nb_type_class , zsumclasses ) 2439 2440 DEALLOCATE(noos_iom_dummy) 2441 2442 1718 2443 1719 2444 END SUBROUTINE dia_dct_wri_NOOS_h … … 1730 2455 !! 1731 2456 !! 2. Write heat transports in "heat_transport" 1732 !! Unit: Peta W : area * Velocity * T * rh op * Cp * 1.e-152457 !! Unit: Peta W : area * Velocity * T * rhau * Cp / 1.e15 1733 2458 !! 1734 2459 !! 3. Write salt transports in "salt_transport" 1735 !! Unit: 10^9 Kg/m^2/s : area * Velocity * S * rhop * 1.e-92460 !! Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6 1736 2461 !! 1737 2462 !!------------------------------------------------------------- … … 1810 2535 WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, & 1811 2536 jclass,classe,zbnd1,zbnd2,& 1812 sec%transport(7,jclass)*1 .e-15,sec%transport(8,jclass)*1.e-15, &1813 ( sec%transport(7,jclass)+sec%transport(8,jclass) )*1 .e-152537 sec%transport(7,jclass)*1000._wp*rcp/1.e15,sec%transport(8,jclass)*1000._wp*rcp/1.e15, & 2538 ( sec%transport(7,jclass)+sec%transport(8,jclass) )*1000._wp*rcp/1.e15 1814 2539 !write salt transport per class 1815 2540 WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, & 1816 2541 jclass,classe,zbnd1,zbnd2,& 1817 sec%transport(9,jclass)*1 .e-9,sec%transport(10,jclass)*1.e-9,&1818 (sec%transport(9,jclass)+sec%transport(10,jclass))*1 .e-92542 sec%transport(9,jclass)*1000._wp/1.e9,sec%transport(10,jclass)*1000._wp/1.e9,& 2543 (sec%transport(9,jclass)+sec%transport(10,jclass))*1000._wp/1.e9 1819 2544 ENDIF 1820 2545 … … 1835 2560 WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, & 1836 2561 jclass,"total",zbnd1,zbnd2,& 1837 zsumclasses(7)* 1.e-15,zsumclasses(8)*1.e-15,&1838 (zsumclasses(7)+zsumclasses(8) )* 1.e-152562 zsumclasses(7)* 1000._wp*rcp/1.e15,zsumclasses(8)* 1000._wp*rcp/1.e15,& 2563 (zsumclasses(7)+zsumclasses(8) )* 1000._wp*rcp/1.e15 1839 2564 !write total salt transport 1840 2565 WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, & 1841 2566 jclass,"total",zbnd1,zbnd2,& 1842 zsumclasses(9)*1 .e-9,zsumclasses(10)*1.e-9,&1843 (zsumclasses(9)+zsumclasses(10))*1 .e-92567 zsumclasses(9)*1000._wp/1.e9,zsumclasses(10)*1000._wp/1.e9,& 2568 (zsumclasses(9)+zsumclasses(10))*1000._wp/1.e9 1844 2569 ENDIF 1845 2570 … … 1878 2603 !! | I | I+1 | Z=temperature/salinity/density at U-poinT 1879 2604 !! | | | 1880 !! ---------------------------------------- 1. Veritcal interpolation: compute zbis2605 !! ---------------------------------------- 1. Veritcale interpolation: compute zbis 1881 2606 !! | | | interpolation between ptab(I,J,K) and ptab(I,J,K+1) 1882 2607 !! | | | zbis = -
branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r10390 r11066 11 11 USE iom ! I/0 library 12 12 USE wrk_nemo ! working arrays 13 USE diaregmean 13 14 #if defined key_fabm 14 15 USE trc, ONLY: trn -
branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8561 r11066 47 47 USE dia25h ! 25h Mean output 48 48 USE diaopfoam ! Diaopfoam output 49 USE diaregmean ! regionalmean 50 USE diapea ! pea 49 51 USE iom 50 52 USE ioipsl … … 405 407 IF (ln_diaopfoam) THEN 406 408 CALL dia_diaopfoam 409 ENDIF 410 if ( ln_pea ) THEN 411 CALL dia_pea( kt ) 412 ENDIF 413 IF (ln_diaregmean) THEN 414 CALL dia_regmean( kt ) 407 415 ENDIF 408 416 ! -
branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8058 r11066 56 56 PUBLIC iom_getatt, iom_use, iom_context_finalize 57 57 58 INTEGER , PUBLIC :: n_regions_output 59 58 60 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 59 61 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d … … 106 108 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 107 109 !!---------------------------------------------------------------------- 110 111 112 113 114 115 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: tmpregion !: temporary region_mask 116 INTEGER, DIMENSION(3) :: zdimsz ! number of elements in each of the 3 dimensions (i.e., lon, lat, no of masks, 297, 375, 4) for an array 117 INTEGER :: zndims ! number of dimensions in an array (i.e. 3, ) 118 INTEGER :: inum, nmasks,ierr,maskno,idmaskvar,tmpint 119 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: tmp_region_mask_real ! tempory region_mask of reals 120 121 LOGICAL :: ln_diaregmean ! region mean calculation 122 123 124 INTEGER :: ios ! Local integer output status for namelist read 125 LOGICAL :: ln_diaregmean_ascii ! region mean calculation ascii output 126 LOGICAL :: ln_diaregmean_bin ! region mean calculation binary output 127 LOGICAL :: ln_diaregmean_nc ! region mean calculation netcdf output 128 LOGICAL :: ln_diaregmean_karamld ! region mean calculation including kara mld terms 129 LOGICAL :: ln_diaregmean_pea ! region mean calculation including pea terms 130 LOGICAL :: ln_diaregmean_diaar5 ! region mean calculation including AR5 SLR terms 131 LOGICAL :: ln_diaregmean_diasbc ! region mean calculation including Surface BC 132 133 #if defined key_fabm 134 LOGICAL :: ln_diaregmean_bgc ! region mean calculation including BGC 135 #endif 136 ! Read the number region mask to work out how many regions are needed. 137 138 #if defined key_fabm 139 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,& 140 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc,ln_diaregmean_bgc 141 #else 142 NAMELIST/nam_diaregmean/ ln_diaregmean,ln_diaregmean_ascii,ln_diaregmean_bin,ln_diaregmean_nc,& 143 & ln_diaregmean_karamld, ln_diaregmean_pea,ln_diaregmean_diaar5,ln_diaregmean_diasbc 144 #endif 145 146 ! read in Namelist. 147 !!---------------------------------------------------------------------- 148 ! 149 REWIND ( numnam_ref ) ! Read Namelist nam_diatmb in referdiatmbence namelist : TMB diagnostics 150 READ ( numnam_ref, nam_diaregmean, IOSTAT=ios, ERR= 901 ) 151 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaregmean in reference namelist', lwp ) 152 153 REWIND( numnam_cfg ) ! Namelist nam_diatmb in configuration namelist TMB diagnostics 154 READ ( numnam_cfg, nam_diaregmean, IOSTAT = ios, ERR = 902 ) 155 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaregmean in configuration namelist', lwp ) 156 IF(lwm) WRITE ( numond, nam_diaregmean ) 157 158 IF (ln_diaregmean) THEN 159 160 ! Open region mask for region means, and retrieve the size of the mask (number of levels) 161 CALL iom_open ( 'region_mask.nc', inum ) 162 idmaskvar = iom_varid( inum, 'mask', kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE.) 163 nmasks = zdimsz(3) 164 165 ! read in the region mask (which contains floating point numbers) into a temporary array of reals. 166 ALLOCATE( tmp_region_mask_real(jpi,jpj,nmasks), STAT= ierr ) 167 IF( ierr /= 0 ) CALL ctl_stop( 'dia_regmean_init: failed to allocate tmp_region_mask_real array' ) 168 169 ! Use jpdom_unknown to read in a n layer mask. 170 tmp_region_mask_real(:,:,:) = 0 171 CALL iom_get( inum, jpdom_unknown, 'mask', tmp_region_mask_real(1:nlci,1:nlcj,1:nmasks), & 172 & kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nmasks /) ) 173 174 CALL iom_close( inum ) 175 !Convert the region mask of reals into one of integers. 176 177 178 n_regions_output = 0 179 DO maskno = 1,nmasks 180 tmpint = maxval(int(tmp_region_mask_real(:,:,maskno))) 181 CALL mpp_max( tmpint ) 182 n_regions_output = n_regions_output + (tmpint + 1) 183 END DO 184 185 186 187 ELSE 188 n_regions_output = 1 189 ENDIF 190 191 192 108 193 #if ! defined key_xios2 109 194 ALLOCATE( z_bnds(jpk,2) ) … … 227 312 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 228 313 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 314 315 316 317 CALL iom_set_axis_attr( "region", (/ (REAL(ji,wp), ji=1,n_regions_output) /) ) 318 319 CALL iom_set_axis_attr( "noos", (/ (REAL(ji,wp), ji=1,3) /) ) 320 229 321 230 322 ! automatic definitions of some of the xml attributs -
branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r10728 r11066 87 87 USE stopts 88 88 USE diatmb ! Top,middle,bottom output 89 USE diaregmean ! regional means output 90 USE diapea ! potential energy anomaly output 89 91 USE dia25h ! 25h mean output 90 92 USE diaopfoam ! FOAM operational output … … 493 495 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 494 496 CALL dia_tmb_init ! TMB outputs 497 CALL dia_regmean_init ! TMB outputs 498 CALL dia_pea_init ! TMB outputs 495 499 CALL dia_25h_init ! 25h mean outputs 496 500 CALL dia_diaopfoam_init ! FOAM operational output … … 630 634 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 631 635 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 636 IF( numdct_NOOS /= -1 ) CLOSE( numdct_NOOS ) ! NOOS transports 632 637 633 638 !
Note: See TracChangeset
for help on using the changeset viewer.