- Timestamp:
- 2020-12-04T12:36:47+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13787_doc_latex_recovery/src/OCE/DIA
- Files:
-
- 3 edited
-
diaar5.F90 (modified) (23 diffs)
-
diahsb.F90 (modified) (16 diffs)
-
diaptr.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13787_doc_latex_recovery/src/OCE/DIA/diaar5.F90
r14066 r14085 10 10 !! dia_ar5_init : initialisation of AR5 diagnostics 11 11 !!---------------------------------------------------------------------- 12 USE oce ! ocean dynamics and active tracers 12 USE oce ! ocean dynamics and active tracers 13 13 USE dom_oce ! ocean space and time domain 14 14 USE eosbn2 ! equation of state (eos_bn2 routine) … … 37 37 38 38 LOGICAL :: l_ar5 39 39 40 40 !! * Substitutions 41 41 # include "do_loop_substitute.h90" … … 78 78 REAL(wp) :: zaw, zbw, zrw 79 79 ! 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d, zpe ! 2D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d, zpe ! 2D workspace 82 82 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd, ztpot, zgdept ! 3D workspace (zgdept: needed to use the substitute) 83 83 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace … … 85 85 !!-------------------------------------------------------------------- 86 86 IF( ln_timing ) CALL timing_start('dia_ar5') 87 87 88 88 IF( kt == nit000 ) CALL dia_ar5_init 89 89 90 IF( l_ar5 ) THEN 90 IF( l_ar5 ) THEN 91 91 ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 92 92 ALLOCATE( zrhd(jpi,jpj,jpk) ) … … 99 99 CALL iom_put( 'areacello', e1e2t(:,:) ) 100 100 ! 101 IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN 101 IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN 102 102 zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace 103 103 DO jk = 1, jpkm1 … … 106 106 DO jk = 1, jpk 107 107 z3d(:,:,jk) = rho0 * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 108 END DO 108 END DO 109 109 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 110 110 CALL iom_put( 'masscello' , z3d (:,:,:) ) ! ocean mass 111 ENDIF 111 ENDIF 112 112 ! 113 113 IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness … … 117 117 END_2D 118 118 CALL iom_put( 'e3tb', z2d ) 119 ENDIF 120 ! 121 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN 119 ENDIF 120 ! 121 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN 122 122 ! ! total volume of liquid seawater 123 zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) ) 123 zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) ) 124 124 zvol = vol0 + zvolssh 125 125 126 126 CALL iom_put( 'voltot', zvol ) 127 127 CALL iom_put( 'sshtot', zvolssh / area_tot ) … … 130 130 ENDIF 131 131 132 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 133 ! 132 IF( iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) THEN 133 ! 134 134 ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm) ! thermosteric ssh 135 135 ztsn(:,:,:,jp_sal) = sn0(:,:,:) … … 157 157 !!gm 158 158 END IF 159 ! 160 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 159 ! 160 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 161 161 zssh_steric = - zarho / area_tot 162 162 CALL iom_put( 'sshthster', zssh_steric ) 163 163 164 164 ! ! steric sea surface height 165 165 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice … … 179 179 END IF 180 180 END IF 181 ! 182 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 181 ! 182 zarho = glob_sum( 'diaar5', e1e2t(:,:) * zbotpres(:,:) ) 183 183 zssh_steric = - zarho / area_tot 184 184 CALL iom_put( 'sshsteric', zssh_steric ) … … 192 192 ENDIF 193 193 194 IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN 194 IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN 195 195 ! ! Mean density anomalie, temperature and salinity 196 196 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity … … 206 206 DO jj = 1, jpj 207 207 iks = mikt(ji,jj) 208 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm) 209 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm) 208 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm) 209 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm) 210 210 END DO 211 211 END DO 212 212 ELSE 213 ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) 214 ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) 213 ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) 214 ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) 215 215 END IF 216 216 ENDIF … … 218 218 ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) ) 219 219 zsal = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) ) 220 zmass = rho0 * ( zarho + zvol ) 220 zmass = rho0 * ( zarho + zvol ) 221 221 ! 222 222 CALL iom_put( 'masstot', zmass ) … … 224 224 CALL iom_put( 'saltot' , zsal / zvol ) 225 225 ! 226 ENDIF 226 ENDIF 227 227 228 228 IF( ln_teos10 ) THEN ! ! potential temperature (TEOS-10 case) … … 244 244 z2d(:,:) = z2d(:,:) + e1e2t(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 245 245 END DO 246 ztemp = glob_sum( 'diaar5', z2d(:,:) ) 246 ztemp = glob_sum( 'diaar5', z2d(:,:) ) 247 247 CALL iom_put( 'temptot_pot', ztemp / zvol ) 248 248 ENDIF 249 249 ! 250 250 IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10 251 zsst = glob_sum( 'diaar5', e1e2t(:,:) * ztpot(:,:,1) ) 251 zsst = glob_sum( 'diaar5', e1e2t(:,:) * ztpot(:,:,1) ) 252 252 CALL iom_put( 'ssttot', zsst / area_tot ) 253 253 ENDIF … … 258 258 z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ztpot(ji,jj,jk) 259 259 END_3D 260 CALL iom_put( 'tosmint_pot', z2d ) 260 CALL iom_put( 'tosmint_pot', z2d ) 261 261 ENDIF 262 262 DEALLOCATE( ztpot ) 263 263 ENDIF 264 ELSE 264 ELSE 265 265 IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80 266 266 zsst = glob_sum( 'diaar5', e1e2t(:,:) * ts(:,:,1,jp_tem,Kmm) ) … … 269 269 ENDIF 270 270 271 IF( iom_use( 'tnpeo' )) THEN 271 IF( iom_use( 'tnpeo' )) THEN 272 272 ! Work done against stratification by vertical mixing 273 273 ! Exclude points where rn2 is negative as convection kicks in here and … … 358 358 ENDIF 359 359 ENDIF 360 360 361 361 END SUBROUTINE dia_ar5_hst 362 362 … … 365 365 !!---------------------------------------------------------------------- 366 366 !! *** ROUTINE dia_ar5_init *** 367 !! 367 !! 368 368 !! ** Purpose : initialization for AR5 diagnostic computation 369 369 !!---------------------------------------------------------------------- … … 371 371 INTEGER :: ik, idep 372 372 INTEGER :: ji, jj, jk ! dummy loop indices 373 REAL(wp) :: zztmp 373 REAL(wp) :: zztmp 374 374 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 375 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zvol0 375 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zvol0 376 376 ! 377 377 !!---------------------------------------------------------------------- 378 378 ! 379 379 l_ar5 = .FALSE. 380 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & 381 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 380 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & 381 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 382 382 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) .OR. & 383 383 & iom_use( 'uadv_heattr' ) .OR. iom_use( 'udiff_heattr' ) .OR. & … … 386 386 & iom_use( 'vadv_salttr' ) .OR. iom_use( 'vdiff_salttr' ) .OR. & 387 387 & iom_use( 'rhop' ) ) L_ar5 = .TRUE. 388 388 389 389 IF( l_ar5 ) THEN 390 390 ! … … 400 400 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 401 401 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * e1e2t(ji,jj) 402 thick0(ji,jj) = thick0(ji,jj) + idep 402 thick0(ji,jj) = thick0(ji,jj) + idep 403 403 END_3D 404 404 vol0 = glob_sum( 'diaar5', zvol0 ) … … 412 412 CALL iom_close( inum ) 413 413 414 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 414 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) 415 415 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 416 416 IF( ln_zps ) THEN ! z-coord. partial steps -
NEMO/branches/2020/dev_r13787_doc_latex_recovery/src/OCE/DIA/diahsb.F90
r14066 r14085 4 4 !! Ocean diagnostics: Heat, salt and volume budgets 5 5 !!====================================================================== 6 !! History : 3.3 ! 2010-09 (M. Leclair) Original code 6 !! History : 3.3 ! 2010-09 (M. Leclair) Original code 7 7 !! ! 2012-10 (C. Rousset) add iom_put 8 8 !!---------------------------------------------------------------------- … … 21 21 USE domvvl ! vertical scale factors 22 22 USE traqsr ! penetrative solar radiation 23 USE trabbc ! bottom boundary condition 23 USE trabbc ! bottom boundary condition 24 24 USE trabbc ! bottom boundary condition 25 25 USE restart ! ocean restart … … 44 44 REAL(wp) :: frc_wn_t, frc_wn_s ! global forcing trends 45 45 ! 46 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 46 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 47 47 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini ! 48 48 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini ! … … 62 62 !!--------------------------------------------------------------------------- 63 63 !! *** ROUTINE dia_hsb *** 64 !! 64 !! 65 65 !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation 66 !! 66 !! 67 67 !! ** Method : - Compute the deviation of heat content, salt content and volume 68 68 !! at the current time step from their values at nit000 … … 75 75 INTEGER :: ji, jj, jk ! dummy loop indice 76 76 REAL(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 77 REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - 77 REAL(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - 78 78 REAL(wp) :: zdiff_v1 , zdiff_v2 ! volume variation 79 79 REAL(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit … … 86 86 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwrk ! 3D workspace 87 87 !!--------------------------------------------------------------------------- 88 IF( ln_timing ) CALL timing_start('dia_hsb') 88 IF( ln_timing ) CALL timing_start('dia_hsb') 89 89 ! 90 90 ts(:,:,:,1,Kmm) = ts(:,:,:,1,Kmm) * tmask(:,:,:) ; ts(:,:,:,1,Kbb) = ts(:,:,:,1,Kbb) * tmask(:,:,:) ; … … 119 119 z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb) 120 120 END IF 121 z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 121 z_wn_trd_t = - glob_sum( 'diahsb', z2d0 ) 122 122 z_wn_trd_s = - glob_sum( 'diahsb', z2d1 ) 123 123 ENDIF … … 145 145 DO ji = 1, jpi 146 146 DO jj = 1, jpj 147 z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 148 z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 147 z2d0(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) * ssh(ji,jj,Kmm) - ssh_hc_loc_ini(ji,jj) ) 148 z2d1(ji,jj) = surf(ji,jj) * ( ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) * ssh(ji,jj,Kmm) - ssh_sc_loc_ini(ji,jj) ) 149 149 END DO 150 150 END DO 151 151 ELSE ! no under ice-shelf seas 152 z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 153 z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 152 z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 153 z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 154 154 END IF 155 z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 156 z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 155 z_ssh_hc = glob_sum_full( 'diahsb', z2d0 ) 156 z_ssh_sc = glob_sum_full( 'diahsb', z2d1 ) 157 157 ENDIF 158 158 ! … … 181 181 zdiff_sc = zdiff_sc - frc_s 182 182 IF( ln_linssh ) THEN 183 zdiff_hc1 = zdiff_hc + z_ssh_hc 183 zdiff_hc1 = zdiff_hc + z_ssh_hc 184 184 zdiff_sc1 = zdiff_sc + z_ssh_sc 185 185 zerr_hc1 = z_ssh_hc - frc_wn_t … … 201 201 !!gm end 202 202 203 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 204 CALL iom_put( 'bgfrctem' , frc_t * rho0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 205 CALL iom_put( 'bgfrchfx' , frc_t * rho0 * rcp / & ! hc - surface forcing (W/m2) 203 CALL iom_put( 'bgfrcvol' , frc_v * 1.e-9 ) ! vol - surface forcing (km3) 204 CALL iom_put( 'bgfrctem' , frc_t * rho0 * rcp * 1.e-20 ) ! hc - surface forcing (1.e20 J) 205 CALL iom_put( 'bgfrchfx' , frc_t * rho0 * rcp / & ! hc - surface forcing (W/m2) 206 206 & ( surf_tot * kt * rn_Dt ) ) 207 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 207 CALL iom_put( 'bgfrcsal' , frc_s * 1.e-9 ) ! sc - surface forcing (psu*km3) 208 208 209 209 IF( .NOT. ln_linssh ) THEN 210 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 210 CALL iom_put( 'bgtemper' , zdiff_hc / zvol_tot ) ! Temperature drift (C) 211 211 CALL iom_put( 'bgsaline' , zdiff_sc / zvol_tot ) ! Salinity drift (PSU) 212 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 213 CALL iom_put( 'bgheatfx' , zdiff_hc * rho0 * rcp / & ! Heat flux drift (W/m2) 212 CALL iom_put( 'bgheatco' , zdiff_hc * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 213 CALL iom_put( 'bgheatfx' , zdiff_hc * rho0 * rcp / & ! Heat flux drift (W/m2) 214 214 & ( surf_tot * kt * rn_Dt ) ) 215 215 CALL iom_put( 'bgsaltco' , zdiff_sc * 1.e-9 ) ! Salt content drift (psu*km3) 216 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 217 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 216 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 217 CALL iom_put( 'bgvole3t' , zdiff_v2 * 1.e-9 ) ! volume e3t drift (km3) 218 218 ! 219 219 IF( kt == nitend .AND. lwp ) THEN … … 228 228 ! 229 229 ELSE 230 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 230 CALL iom_put( 'bgtemper' , zdiff_hc1 / zvol_tot) ! Heat content drift (C) 231 231 CALL iom_put( 'bgsaline' , zdiff_sc1 / zvol_tot) ! Salt content drift (PSU) 232 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 233 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0 * rcp / & ! Heat flux drift (W/m2) 232 CALL iom_put( 'bgheatco' , zdiff_hc1 * 1.e-20 * rho0 * rcp ) ! Heat content drift (1.e20 J) 233 CALL iom_put( 'bgheatfx' , zdiff_hc1 * rho0 * rcp / & ! Heat flux drift (W/m2) 234 234 & ( surf_tot * kt * rn_Dt ) ) 235 235 CALL iom_put( 'bgsaltco' , zdiff_sc1 * 1.e-9 ) ! Salt content drift (psu*km3) 236 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 236 CALL iom_put( 'bgvolssh' , zdiff_v1 * 1.e-9 ) ! volume ssh drift (km3) 237 237 CALL iom_put( 'bgmistem' , zerr_hc1 / zvol_tot ) ! hc - error due to free surface (C) 238 238 CALL iom_put( 'bgmissal' , zerr_sc1 / zvol_tot ) ! sc - error due to free surface (psu) … … 249 249 !!--------------------------------------------------------------------- 250 250 !! *** ROUTINE dia_hsb_rst *** 251 !! 251 !! 252 252 !! ** Purpose : Read or write DIA file in restart file 253 253 !! … … 261 261 !!---------------------------------------------------------------------- 262 262 ! 263 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 263 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 264 264 IF( ln_rstart ) THEN !* Read the restart file 265 265 ! … … 298 298 END DO 299 299 frc_v = 0._wp ! volume trend due to forcing 300 frc_t = 0._wp ! heat content - - - - 301 frc_s = 0._wp ! salt content - - - - 300 frc_t = 0._wp ! heat content - - - - 301 frc_s = 0._wp ! salt content - - - - 302 302 IF( ln_linssh ) THEN 303 303 IF( ln_isfcav ) THEN … … 349 349 !!--------------------------------------------------------------------------- 350 350 !! *** ROUTINE dia_hsb *** 351 !! 351 !! 352 352 !! ** Purpose: Initialization for the heat salt volume budgets 353 !! 353 !! 354 354 !! ** Method : Compute initial heat content, salt content and volume 355 355 !! … … 403 403 surf_tot = glob_sum( 'diahsb', surf(:,:) ) ! total ocean surface area 404 404 405 IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) 405 IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' ) 406 406 ! 407 407 ! ---------------------------------- ! -
NEMO/branches/2020/dev_r13787_doc_latex_recovery/src/OCE/DIA/diaptr.F90
r14066 r14085 66 66 !!---------------------------------------------------------------------- 67 67 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 68 !! $Id$ 68 !! $Id$ 69 69 !! Software governed by the CeCILL license (see ./LICENSE) 70 70 !!---------------------------------------------------------------------- … … 75 75 !! *** ROUTINE dia_ptr *** 76 76 !!---------------------------------------------------------------------- 77 INTEGER , INTENT(in) :: kt ! ocean time-step index 77 INTEGER , INTENT(in) :: kt ! ocean time-step index 78 78 INTEGER , INTENT(in) :: Kmm ! time level index 79 79 REAL(wp), DIMENSION(A2D(nn_hls),jpk) , INTENT(in), OPTIONAL :: pvtr ! j-effective transport … … 177 177 178 178 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 179 ! Calculate barotropic heat and salt transport here 179 ! Calculate barotropic heat and salt transport here 180 180 ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 181 181 ! … … 245 245 ! 246 246 ! ! Advective and diffusive heat and salt transport 247 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 248 ! 247 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 248 ! 249 249 DO jn = 1, nbasin 250 250 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) … … 263 263 ENDIF 264 264 ! 265 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 266 ! 265 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 266 ! 267 267 DO jn = 1, nbasin 268 268 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) … … 281 281 ENDIF 282 282 ! 283 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 284 ! 283 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 284 ! 285 285 DO jn = 1, nbasin 286 286 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) … … 319 319 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 320 320 CALL iom_get_var( 'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 321 z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 321 z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 322 322 CALL iom_put( 'uocetr_vsum_cumul', z2d ) 323 323 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) ! Revert to tile domain … … 455 455 !!---------------------------------------------------------------------- 456 456 !! *** ROUTINE dia_ptr_init *** 457 !! 457 !! 458 458 !! ** Purpose : Initialization 459 459 !!---------------------------------------------------------------------- … … 472 472 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 473 473 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) 474 474 475 475 IF(lwp) THEN ! Control print 476 476 WRITE(numout,*) … … 480 480 ENDIF 481 481 482 IF( l_diaptr ) THEN 482 IF( l_diaptr ) THEN 483 483 ! 484 484 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) … … 489 489 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 490 490 491 btmsk(:,:,1) = tmask_i(:,:) 491 btmsk(:,:,1) = tmask_i(:,:) 492 492 IF( nbasin == 5 ) THEN ! nbasin has been initialized in iom_init to define the axis "basin" 493 493 CALL iom_open( 'subbasins', inum ) … … 504 504 WHERE( gphit(:,:)*tmask_i(:,:) < -34._wp) 505 505 zmsk(:,:) = 0._wp ! mask out Southern Ocean 506 ELSE WHERE 506 ELSE WHERE 507 507 zmsk(:,:) = ssmask(:,:) 508 508 END WHERE 509 btmsk34(:,:,1) = btmsk(:,:,1) 509 btmsk34(:,:,1) = btmsk(:,:,1) 510 510 DO jn = 2, nbasin 511 511 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only … … 514 514 ! Initialise arrays to zero because diatpr is called before they are first calculated 515 515 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 516 hstr_adv(:,:,:) = 0._wp 517 hstr_ldf(:,:,:) = 0._wp 518 hstr_eiv(:,:,:) = 0._wp 519 hstr_ove(:,:,:) = 0._wp 516 hstr_adv(:,:,:) = 0._wp 517 hstr_ldf(:,:,:) = 0._wp 518 hstr_eiv(:,:,:) = 0._wp 519 hstr_ove(:,:,:) = 0._wp 520 520 hstr_btr(:,:,:) = 0._wp ! 521 521 hstr_vtr(:,:,:) = 0._wp ! … … 525 525 ll_init = .FALSE. 526 526 ! 527 ENDIF 528 ! 527 ENDIF 528 ! 529 529 END SUBROUTINE dia_ptr_init 530 530 531 531 532 SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx ) 532 SUBROUTINE dia_ptr_hst( ktra, cptr, pvflx ) 533 533 !!---------------------------------------------------------------------- 534 534 !! *** ROUTINE dia_ptr_hst *** … … 727 727 ! 728 728 INTEGER :: ji,jj,jc ! dummy loop arguments 729 INTEGER :: ijpj ! ??? 729 INTEGER :: ijpj ! ??? 730 730 REAL(wp), DIMENSION(jpi,jpj) :: p_fval ! function value 731 731 !!-------------------------------------------------------------------- 732 ! 732 ! 733 733 ijpj = jpj ! ??? 734 734 p_fval(:,:) = 0._wp … … 738 738 END_2D 739 739 END DO 740 ! 740 ! 741 741 END FUNCTION ptr_ci_2d 742 742
Note: See TracChangeset
for help on using the changeset viewer.
