Changeset 12193 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE
- Timestamp:
- 2019-12-11T17:15:54+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE
- Files:
-
- 22 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diaar5.F90
r11949 r12193 72 72 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 73 73 ! 74 INTEGER :: ji, jj, jk ! dummy loop arguments75 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass 74 INTEGER :: ji, jj, jk, iks, ikb ! dummy loop arguments 75 REAL(wp) :: zvolssh, zvol, zssh_steric, zztmp, zarho, ztemp, zsal, zmass, zsst 76 76 REAL(wp) :: zaw, zbw, zrw 77 77 ! 78 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop 79 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zpe, z2d ! 2D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zrhd , zrhop, ztpot ! 3D workspace 81 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 82 82 … … 87 87 88 88 IF( l_ar5 ) THEN 89 ALLOCATE( zarea_ssh(jpi,jpj) , zbotpres(jpi,jpj) )89 ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 90 90 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk) ) 91 91 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) … … 93 93 ENDIF 94 94 ! 95 CALL iom_put( 'e2u' , e2u (:,:) ) 96 CALL iom_put( 'e1v' , e1v (:,:) ) 97 CALL iom_put( 'areacello', area(:,:) ) 98 ! 99 IF( iom_use( 'volcello' ) .OR. iom_use( 'masscello' ) ) THEN 100 zrhd(:,:,jpk) = 0._wp ! ocean volume ; rhd is used as workspace 101 DO jk = 1, jpkm1 102 zrhd(:,:,jk) = area(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 103 END DO 104 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 105 CALL iom_put( 'masscello' , rau0 * e3t(:,:,:,Kmm) * tmask(:,:,:) ) ! ocean mass 106 ENDIF 107 ! 108 IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness 109 DO jj = 1, jpj 110 DO ji = 1, jpi 111 ikb = mbkt(ji,jj) 112 z2d(ji,jj) = e3t(ji,jj,ikb,Kmm) 113 END DO 114 END DO 115 CALL iom_put( 'e3tb', z2d ) 116 ENDIF 117 ! 95 118 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) ) THEN 96 119 ! ! total volume of liquid seawater 97 zvolssh = SUM( zarea_ssh(:,:) ) 98 CALL mpp_sum( 'diaar5', zvolssh ) 99 zvol = vol0 + zvolssh 120 zvolssh = glob_sum( 'diaar5', zarea_ssh(:,:) ) 121 zvol = vol0 + zvolssh 100 122 101 123 CALL iom_put( 'voltot', zvol ) … … 119 141 DO ji = 1, jpi 120 142 DO jj = 1, jpj 121 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 143 iks = mikt(ji,jj) 144 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 122 145 END DO 123 146 END DO … … 130 153 END IF 131 154 ! 132 zarho = SUM( area(:,:) * zbotpres(:,:) ) 133 CALL mpp_sum( 'diaar5', zarho ) 155 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) ) 134 156 zssh_steric = - zarho / area_tot 135 157 CALL iom_put( 'sshthster', zssh_steric ) … … 148 170 DO ji = 1,jpi 149 171 DO jj = 1,jpj 150 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,mikt(ji,jj)) + riceload(ji,jj) 172 iks = mikt(ji,jj) 173 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 151 174 END DO 152 175 END DO … … 156 179 END IF 157 180 ! 158 zarho = SUM( area(:,:) * zbotpres(:,:) ) 159 CALL mpp_sum( 'diaar5', zarho ) 181 zarho = glob_sum( 'diaar5', area(:,:) * zbotpres(:,:) ) 160 182 zssh_steric = - zarho / area_tot 161 183 CALL iom_put( 'sshsteric', zssh_steric ) 162 163 184 ! ! ocean bottom pressure 164 185 zztmp = rau0 * grav * 1.e-4_wp ! recover pressure from pressure anomaly and cover to dbar = 1.e4 Pa … … 169 190 170 191 IF( iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) ) THEN 171 ! ! Mean density anomalie, temperature and salinity172 ztemp = 0._wp173 zsal = 0._wp174 DO jk = 1, jpkm1175 DO jj = 1, jpj176 DO ji = 1, jpi177 zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm)178 ztemp = ztemp + zztmp * ts(ji,jj,jk,jp_tem,Kmm)179 zsal = zsal + zztmp * ts(ji,jj,jk,jp_sal,Kmm)180 ENDDO181 ENDDO182 END DO 183 IF( ln_linssh ) THEN192 ! ! Mean density anomalie, temperature and salinity 193 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 194 DO jk = 1, jpkm1 195 DO jj = 1, jpj 196 DO ji = 1, jpi 197 zztmp = area(ji,jj) * e3t(ji,jj,jk,Kmm) 198 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) 199 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zztmp * ts(ji,jj,jk,jp_sal,Kmm) 200 ENDDO 201 ENDDO 202 ENDDO 203 204 IF( ln_linssh ) THEN 184 205 IF( ln_isfcav ) THEN 185 206 DO ji = 1, jpi 186 207 DO jj = 1, jpj 187 ztemp = ztemp + zarea_ssh(ji,jj) * ts(ji,jj,mikt(ji,jj),jp_tem,Kmm) 188 zsal = zsal + zarea_ssh(ji,jj) * ts(ji,jj,mikt(ji,jj),jp_sal,Kmm) 208 iks = mikt(ji,jj) 209 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_tem,Kmm) 210 ztsn(ji,jj,1,jp_sal) = ztsn(ji,jj,1,jp_sal) + zarea_ssh(ji,jj) * ts(ji,jj,iks,jp_sal,Kmm) 189 211 END DO 190 212 END DO 191 213 ELSE 192 zt emp = ztemp + SUM( zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) )193 z sal = zsal + SUM( zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) )214 ztsn(:,:,1,jp_tem) = ztsn(:,:,1,jp_tem) + zarea_ssh(:,:) * ts(:,:,1,jp_tem,Kmm) 215 ztsn(:,:,1,jp_sal) = ztsn(:,:,1,jp_sal) + zarea_ssh(:,:) * ts(:,:,1,jp_sal,Kmm) 194 216 END IF 195 217 ENDIF 196 IF( lk_mpp ) THEN 197 CALL mpp_sum( 'diaar5', ztemp ) 198 CALL mpp_sum( 'diaar5', zsal ) 199 END IF 200 ! 201 zmass = rau0 * ( zarho + zvol ) ! total mass of liquid seawater 202 ztemp = ztemp / zvol ! potential temperature in liquid seawater 203 zsal = zsal / zvol ! Salinity of liquid seawater 218 ! 219 ztemp = glob_sum( 'diaar5', ztsn(:,:,1,jp_tem) ) 220 zsal = glob_sum( 'diaar5', ztsn(:,:,1,jp_sal) ) 221 zmass = rau0 * ( zarho + zvol ) 204 222 ! 205 223 CALL iom_put( 'masstot', zmass ) 206 CALL iom_put( 'temptot', ztemp ) 207 CALL iom_put( 'saltot' , zsal ) 208 ! 224 CALL iom_put( 'temptot', ztemp / zvol ) 225 CALL iom_put( 'saltot' , zsal / zvol ) 226 ! 227 ENDIF 228 229 IF( ln_teos10 ) THEN ! ! potential temperature (TEOS-10 case) 230 IF( iom_use( 'toce_pot') .OR. iom_use( 'temptot_pot' ) .OR. iom_use( 'sst_pot' ) & 231 .OR. iom_use( 'ssttot' ) .OR. iom_use( 'tosmint_pot' ) ) THEN 232 ! 233 ALLOCATE( ztpot(jpi,jpj,jpk) ) 234 ztpot(:,:,jpk) = 0._wp 235 DO jk = 1, jpkm1 236 ztpot(:,:,jk) = eos_pt_from_ct( ts(:,:,jk,jp_tem,Kmm), ts(:,:,jk,jp_sal,Kmm) ) 237 END DO 238 ! 239 CALL iom_put( 'toce_pot', ztpot(:,:,:) ) ! potential temperature (TEOS-10 case) 240 CALL iom_put( 'sst_pot' , ztpot(:,:,1) ) ! surface temperature 241 ! 242 IF( iom_use( 'temptot_pot' ) ) THEN ! Output potential temperature in case we use TEOS-10 243 z2d(:,:) = 0._wp 244 DO jk = 1, jpkm1 245 z2d(:,:) = z2d(:,:) + area(:,:) * e3t(:,:,jk,Kmm) * ztpot(:,:,jk) 246 END DO 247 ztemp = glob_sum( 'diaar5', z2d(:,:) ) 248 CALL iom_put( 'temptot_pot', ztemp / zvol ) 249 ENDIF 250 ! 251 IF( iom_use( 'ssttot' ) ) THEN ! Output potential temperature in case we use TEOS-10 252 zsst = glob_sum( 'diaar5', area(:,:) * ztpot(:,:,1) ) 253 CALL iom_put( 'ssttot', zsst / area_tot ) 254 ENDIF 255 ! Vertical integral of temperature 256 IF( iom_use( 'tosmint_pot') ) THEN 257 z2d(:,:) = 0._wp 258 DO jk = 1, jpkm1 259 DO jj = 1, jpj 260 DO ji = 1, jpi ! vector opt. 261 z2d(ji,jj) = z2d(ji,jj) + rau0 * e3t(ji,jj,jk,Kmm) * ztpot(ji,jj,jk) 262 END DO 263 END DO 264 END DO 265 CALL iom_put( 'tosmint_pot', z2d ) 266 ENDIF 267 DEALLOCATE( ztpot ) 268 ENDIF 269 ELSE 270 IF( iom_use('ssttot') ) THEN ! Output sst in case we use EOS-80 271 zsst = glob_sum( 'diaar5', area(:,:) * ts(:,:,1,jp_tem,Kmm) ) 272 CALL iom_put('ssttot', zsst / area_tot ) 273 ENDIF 209 274 ENDIF 210 275 211 276 IF( iom_use( 'tnpeo' )) THEN 212 ! Work done against stratification by vertical mixing213 ! Exclude points where rn2 is negative as convection kicks in here and214 ! work is not being done against stratification277 ! Work done against stratification by vertical mixing 278 ! Exclude points where rn2 is negative as convection kicks in here and 279 ! work is not being done against stratification 215 280 ALLOCATE( zpe(jpi,jpj) ) 216 281 zpe(:,:) = 0._wp … … 220 285 DO ji = 1, jpi 221 286 IF( rn2(ji,jj,jk) > 0._wp ) THEN 222 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 223 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 224 !!gm this can be reduced to : (depw-dept) / e3w (NB idem dans bn2 !) 225 ! zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) 226 !!gm end 287 zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) 227 288 ! 228 289 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 229 290 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 230 291 ! 231 zpe(ji, jj) = zpe(ji, jj)&292 zpe(ji, jj) = zpe(ji,jj) & 232 293 & - grav * ( avt(ji,jj,jk) * zaw * (ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & 233 294 & - avs(ji,jj,jk) * zbw * (ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) ) … … 240 301 DO ji = 1, jpi 241 302 DO jj = 1, jpj 242 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * e3w(ji, jj,jk,Kmm)303 zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rau0 * e3w(ji,jj,jk,Kmm) 243 304 END DO 244 305 END DO 245 306 END DO 246 307 ENDIF 247 !!gm useless lbc_lnk since the computation above is performed over 1:jpi & 1:jpj248 !!gm CALL lbc_lnk( 'diaar5', zpe, 'T', 1._wp)249 308 CALL iom_put( 'tnpeo', zpe ) 250 309 DEALLOCATE( zpe ) … … 252 311 253 312 IF( l_ar5 ) THEN 254 DEALLOCATE( zarea_ssh , zbotpres )313 DEALLOCATE( zarea_ssh , zbotpres, z2d ) 255 314 DEALLOCATE( zrhd , zrhop ) 256 315 DEALLOCATE( ztsn ) … … 288 347 CALL lbc_lnk( 'diaar5', z2d, 'U', -1. ) 289 348 IF( cptr == 'adv' ) THEN 290 IF( ktra == jp_tem ) CALL iom_put( "uadv_heattr", rau0_rcp * z2d ) ! advective heat transport in i-direction291 IF( ktra == jp_sal ) CALL iom_put( "uadv_salttr", rau0 * z2d ) ! advective salt transport in i-direction349 IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rau0_rcp * z2d ) ! advective heat transport in i-direction 350 IF( ktra == jp_sal ) CALL iom_put( 'uadv_salttr' , rau0 * z2d ) ! advective salt transport in i-direction 292 351 ENDIF 293 352 IF( cptr == 'ldf' ) THEN 294 IF( ktra == jp_tem ) CALL iom_put( "udiff_heattr", rau0_rcp * z2d ) ! diffusive heat transport in i-direction295 IF( ktra == jp_sal ) CALL iom_put( "udiff_salttr", rau0 * z2d ) ! diffusive salt transport in i-direction353 IF( ktra == jp_tem ) CALL iom_put( 'udiff_heattr' , rau0_rcp * z2d ) ! diffusive heat transport in i-direction 354 IF( ktra == jp_sal ) CALL iom_put( 'udiff_salttr' , rau0 * z2d ) ! diffusive salt transport in i-direction 296 355 ENDIF 297 356 ! … … 306 365 CALL lbc_lnk( 'diaar5', z2d, 'V', -1. ) 307 366 IF( cptr == 'adv' ) THEN 308 IF( ktra == jp_tem ) CALL iom_put( "vadv_heattr", rau0_rcp * z2d ) ! advective heat transport in j-direction309 IF( ktra == jp_sal ) CALL iom_put( "vadv_salttr", rau0 * z2d ) ! advective salt transport in j-direction367 IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rau0_rcp * z2d ) ! advective heat transport in j-direction 368 IF( ktra == jp_sal ) CALL iom_put( 'vadv_salttr' , rau0 * z2d ) ! advective salt transport in j-direction 310 369 ENDIF 311 370 IF( cptr == 'ldf' ) THEN 312 IF( ktra == jp_tem ) CALL iom_put( "vdiff_heattr", rau0_rcp * z2d ) ! diffusive heat transport in j-direction313 IF( ktra == jp_sal ) CALL iom_put( "vdiff_salttr", rau0 * z2d ) ! diffusive salt transport in j-direction371 IF( ktra == jp_tem ) CALL iom_put( 'vdiff_heattr' , rau0_rcp * z2d ) ! diffusive heat transport in j-direction 372 IF( ktra == jp_sal ) CALL iom_put( 'vdiff_salttr' , rau0 * z2d ) ! diffusive salt transport in j-direction 314 373 ENDIF 315 374 … … 324 383 !!---------------------------------------------------------------------- 325 384 INTEGER :: inum 326 INTEGER :: ik 385 INTEGER :: ik, idep 327 386 INTEGER :: ji, jj, jk ! dummy loop indices 328 387 REAL(wp) :: zztmp 329 388 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 389 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zvol0 330 390 ! 331 391 !!---------------------------------------------------------------------- … … 341 401 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 342 402 343 area(:,:) = e1e2t(:,:) * tmask_i(:,:)344 345 area_tot = SUM( area(:,:) ) ; CALL mpp_sum( 'diaar5', area_tot ) 346 347 vol0= 0._wp403 area(:,:) = e1e2t(:,:) 404 area_tot = glob_sum( 'diaar5', area(:,:) ) 405 406 ALLOCATE( zvol0(jpi,jpj) ) 407 zvol0 (:,:) = 0._wp 348 408 thick0(:,:) = 0._wp 349 409 DO jk = 1, jpkm1 350 vol0 = vol0 + SUM( area (:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) ) 351 thick0(:,:) = thick0(:,:) + tmask_i(:,:) * tmask(:,:,jk) * e3t_0(:,:,jk) 352 END DO 353 CALL mpp_sum( 'diaar5', vol0 ) 410 DO jj = 1, jpj ! interpolation of salinity at the last ocean level (i.e. the partial step) 411 DO ji = 1, jpi 412 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 413 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * area(ji,jj) 414 thick0(ji,jj) = thick0(ji,jj) + idep 415 END DO 416 END DO 417 END DO 418 vol0 = glob_sum( 'diaar5', zvol0 ) 419 DEALLOCATE( zvol0 ) 354 420 355 421 IF( iom_use( 'sshthster' ) ) THEN 356 ALLOCATE( zsaldta(jpi,jpj,jp j,jpts) )422 ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) ) 357 423 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 358 424 CALL iom_get ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1 ) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diahth.F90
r11949 r12193 11 11 !! 3.2 ! 2009-07 (S. Masson) hc300 bugfix + cleaning + add new diag 12 12 !!---------------------------------------------------------------------- 13 #if defined key_diahth14 !!----------------------------------------------------------------------15 !! 'key_diahth' : thermocline depth diag.16 !!----------------------------------------------------------------------17 13 !! dia_hth : Compute varius diagnostics associated with the mixed layer 18 14 !!---------------------------------------------------------------------- … … 32 28 PUBLIC dia_hth_alloc ! routine called by nemogcm.F90 33 29 34 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .TRUE.!: thermocline-20d depths flag30 LOGICAL, SAVE :: l_hth !: thermocline-20d depths flag 35 31 36 32 ! note: following variables should move to local variables once iom_put is always used 37 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hth !: depth of the max vertical temperature gradient [m] 38 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd20 !: depth of 20 C isotherm [m] 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd26 !: depth of 26 C isotherm [m] 39 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hd28 !: depth of 28 C isotherm [m] 40 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htc3 !: heat content of first 300 m [W] 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htc7 !: heat content of first 700 m [W] 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: htc20 !: heat content of first 2000 m [W] 40 41 41 42 42 !!---------------------------------------------------------------------- … … 52 52 !!--------------------------------------------------------------------- 53 53 ! 54 ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd28(jpi,jpj), htc3(jpi,jpj), STAT=dia_hth_alloc ) 54 ALLOCATE( hth(jpi,jpj), hd20(jpi,jpj), hd26(jpi,jpj), hd28(jpi,jpj), & 55 & htc3(jpi,jpj), htc7(jpi,jpj), htc20(jpi,jpj), STAT=dia_hth_alloc ) 55 56 ! 56 57 CALL mpp_sum ( 'diahth', dia_hth_alloc ) … … 83 84 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 84 85 !! 85 INTEGER :: ji, jj, jk ! dummy loop arguments 86 INTEGER :: iid, ilevel ! temporary integers 87 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ik20, ik28 ! levels 88 REAL(wp) :: zavt5 = 5.e-4_wp ! Kz criterion for the turbocline depth 89 REAL(wp) :: zrho3 = 0.03_wp ! density criterion for mixed layer depth 90 REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth 91 REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth 92 REAL(wp) :: zthick_0, zcoef ! temporary scalars 93 REAL(wp) :: zztmp, zzdep ! temporary scalars inside do loop 94 REAL(wp) :: zu, zv, zw, zut, zvt ! temporary workspace 95 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2 96 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2 97 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zrho10_3 ! MLD: rho = rho10m + zrho3 98 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zpycn ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) 99 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ztinv ! max of temperature inversion 100 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdepinv ! depth of temperature inversion 101 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zrho0_3 ! MLD rho = rho(surf) = 0.03 102 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zrho0_1 ! MLD rho = rho(surf) = 0.01 103 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zmaxdzT ! max of dT/dz 104 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zthick ! vertical integration thickness 105 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdelr ! delta rho equivalent to deltaT = 0.2 86 INTEGER :: ji, jj, jk ! dummy loop arguments 87 REAL(wp) :: zrho3 = 0.03_wp ! density criterion for mixed layer depth 88 REAL(wp) :: zrho1 = 0.01_wp ! density criterion for mixed layer depth 89 REAL(wp) :: ztem2 = 0.2_wp ! temperature criterion for mixed layer depth 90 REAL(wp) :: zztmp, zzdep ! temporary scalars inside do loop 91 REAL(wp) :: zu, zv, zw, zut, zvt ! temporary workspace 92 REAL(wp), DIMENSION(jpi,jpj) :: zabs2 ! MLD: abs( tn - tn(10m) ) = ztem2 93 REAL(wp), DIMENSION(jpi,jpj) :: ztm2 ! Top of thermocline: tn = tn(10m) - ztem2 94 REAL(wp), DIMENSION(jpi,jpj) :: zrho10_3 ! MLD: rho = rho10m + zrho3 95 REAL(wp), DIMENSION(jpi,jpj) :: zpycn ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) 96 REAL(wp), DIMENSION(jpi,jpj) :: ztinv ! max of temperature inversion 97 REAL(wp), DIMENSION(jpi,jpj) :: zdepinv ! depth of temperature inversion 98 REAL(wp), DIMENSION(jpi,jpj) :: zrho0_3 ! MLD rho = rho(surf) = 0.03 99 REAL(wp), DIMENSION(jpi,jpj) :: zrho0_1 ! MLD rho = rho(surf) = 0.01 100 REAL(wp), DIMENSION(jpi,jpj) :: zmaxdzT ! max of dT/dz 101 REAL(wp), DIMENSION(jpi,jpj) :: zdelr ! delta rho equivalent to deltaT = 0.2 106 102 !!---------------------------------------------------------------------- 107 103 IF( ln_timing ) CALL timing_start('dia_hth') 108 104 109 105 IF( kt == nit000 ) THEN 106 l_hth = .FALSE. 107 IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) .OR. & 108 & iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) .OR. iom_use( 'mldr10_3' ) .OR. & 109 & iom_use( '20d' ) .OR. iom_use( '26d' ) .OR. iom_use( '28d' ) .OR. & 110 & iom_use( 'hc300' ) .OR. iom_use( 'hc700' ) .OR. iom_use( 'hc2000' ) .OR. & 111 & iom_use( 'pycndep' ) .OR. iom_use( 'tinv' ) .OR. iom_use( 'depti' ) ) l_hth = .TRUE. 110 112 ! ! allocate dia_hth array 111 IF( dia_hth_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' ) 112 113 IF(.NOT. ALLOCATED(ik20) ) THEN 114 ALLOCATE(ik20(jpi,jpj), ik28(jpi,jpj), & 115 & zabs2(jpi,jpj), & 116 & ztm2(jpi,jpj), & 117 & zrho10_3(jpi,jpj),& 118 & zpycn(jpi,jpj), & 119 & ztinv(jpi,jpj), & 120 & zdepinv(jpi,jpj), & 121 & zrho0_3(jpi,jpj), & 122 & zrho0_1(jpi,jpj), & 123 & zmaxdzT(jpi,jpj), & 124 & zthick(jpi,jpj), & 125 & zdelr(jpi,jpj), STAT=ji) 126 CALL mpp_sum('diahth', ji) 127 IF( ji /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard ocean arrays' ) 128 END IF 129 130 IF(lwp) WRITE(numout,*) 131 IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth' 132 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 133 IF(lwp) WRITE(numout,*) 113 IF( l_hth ) THEN 114 IF( dia_hth_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_hth : unable to allocate standard arrays' ) 115 IF(lwp) WRITE(numout,*) 116 IF(lwp) WRITE(numout,*) 'dia_hth : diagnostics of the thermocline depth' 117 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 118 IF(lwp) WRITE(numout,*) 119 ENDIF 134 120 ENDIF 135 121 136 ! initialization 137 ztinv (:,:) = 0._wp 138 zdepinv(:,:) = 0._wp 139 zmaxdzT(:,:) = 0._wp 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 143 hth (ji,jj) = zztmp 144 zabs2 (ji,jj) = zztmp 145 ztm2 (ji,jj) = zztmp 146 zrho10_3(ji,jj) = zztmp 147 zpycn (ji,jj) = zztmp 148 END DO 149 END DO 150 IF( nla10 > 1 ) THEN 151 DO jj = 1, jpj 152 DO ji = 1, jpi 153 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 154 zrho0_3(ji,jj) = zztmp 155 zrho0_1(ji,jj) = zztmp 156 END DO 157 END DO 122 IF( l_hth ) THEN 123 ! 124 IF( iom_use( 'mlddzt' ) .OR. iom_use( 'mldr0_3' ) .OR. iom_use( 'mldr0_1' ) ) THEN 125 ! initialization 126 ztinv (:,:) = 0._wp 127 zdepinv(:,:) = 0._wp 128 zmaxdzT(:,:) = 0._wp 129 DO jj = 1, jpj 130 DO ji = 1, jpi 131 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 132 hth (ji,jj) = zztmp 133 zabs2 (ji,jj) = zztmp 134 ztm2 (ji,jj) = zztmp 135 zrho10_3(ji,jj) = zztmp 136 zpycn (ji,jj) = zztmp 137 END DO 138 END DO 139 IF( nla10 > 1 ) THEN 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 143 zrho0_3(ji,jj) = zztmp 144 zrho0_1(ji,jj) = zztmp 145 END DO 146 END DO 147 ENDIF 148 149 ! Preliminary computation 150 ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) 151 DO jj = 1, jpj 152 DO ji = 1, jpi 153 IF( tmask(ji,jj,nla10) == 1. ) THEN 154 zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) & 155 & - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) & 156 & - 0.0100 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_sal,Kmm) 157 zv = 5891.00 + 38.000 * ts(ji,jj,nla10,jp_tem,Kmm) + 3.00 * ts(ji,jj,nla10,jp_sal,Kmm) & 158 & - 0.3750 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) 159 zut = 11.25 - 0.149 * ts(ji,jj,nla10,jp_tem,Kmm) - 0.01 * ts(ji,jj,nla10,jp_sal,Kmm) 160 zvt = 38.00 - 0.750 * ts(ji,jj,nla10,jp_tem,Kmm) 161 zw = (zu + 0.698*zv) * (zu + 0.698*zv) 162 zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 163 ELSE 164 zdelr(ji,jj) = 0._wp 165 ENDIF 166 END DO 167 END DO 168 169 ! ------------------------------------------------------------- ! 170 ! thermocline depth: strongest vertical gradient of temperature ! 171 ! turbocline depth (mixing layer depth): avt = zavt5 ! 172 ! MLD: rho = rho(1) + zrho3 ! 173 ! MLD: rho = rho(1) + zrho1 ! 174 ! ------------------------------------------------------------- ! 175 DO jk = jpkm1, 2, -1 ! loop from bottom to 2 176 DO jj = 1, jpj 177 DO ji = 1, jpi 178 ! 179 zzdep = gdepw(ji,jj,jk,Kmm) 180 zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) & 181 & / zzdep * tmask(ji,jj,jk) ! vertical gradient of temperature (dT/dz) 182 zzdep = zzdep * tmask(ji,jj,1) 183 184 IF( zztmp > zmaxdzT(ji,jj) ) THEN 185 zmaxdzT(ji,jj) = zztmp 186 hth (ji,jj) = zzdep ! max and depth of dT/dz 187 ENDIF 188 189 IF( nla10 > 1 ) THEN 190 zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1) ! delta rho(1) 191 IF( zztmp > zrho3 ) zrho0_3(ji,jj) = zzdep ! > 0.03 192 IF( zztmp > zrho1 ) zrho0_1(ji,jj) = zzdep ! > 0.01 193 ENDIF 194 END DO 195 END DO 196 END DO 197 198 CALL iom_put( 'mlddzt', hth ) ! depth of the thermocline 199 IF( nla10 > 1 ) THEN 200 CALL iom_put( 'mldr0_3', zrho0_3 ) ! MLD delta rho(surf) = 0.03 201 CALL iom_put( 'mldr0_1', zrho0_1 ) ! MLD delta rho(surf) = 0.01 202 ENDIF 203 ! 204 ENDIF 205 ! 206 IF( iom_use( 'mld_dt02' ) .OR. iom_use( 'topthdep' ) .OR. iom_use( 'mldr10_3' ) .OR. & 207 & iom_use( 'pycndep' ) .OR. iom_use( 'tinv' ) .OR. iom_use( 'depti' ) ) THEN 208 ! ------------------------------------------------------------- ! 209 ! MLD: abs( tn - tn(10m) ) = ztem2 ! 210 ! Top of thermocline: tn = tn(10m) - ztem2 ! 211 ! MLD: rho = rho10m + zrho3 ! 212 ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) ! 213 ! temperature inversion: max( 0, max of tn - tn(10m) ) ! 214 ! depth of temperature inversion ! 215 ! ------------------------------------------------------------- ! 216 DO jk = jpkm1, nlb10, -1 ! loop from bottom to nlb10 217 DO jj = 1, jpj 218 DO ji = 1, jpi 219 ! 220 zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) 221 ! 222 zztmp = ts(ji,jj,nla10,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ! - delta T(10m) 223 IF( ABS(zztmp) > ztem2 ) zabs2 (ji,jj) = zzdep ! abs > 0.2 224 IF( zztmp > ztem2 ) ztm2 (ji,jj) = zzdep ! > 0.2 225 zztmp = -zztmp ! delta T(10m) 226 IF( zztmp > ztinv(ji,jj) ) THEN ! temperature inversion 227 ztinv(ji,jj) = zztmp 228 zdepinv (ji,jj) = zzdep ! max value and depth 229 ENDIF 230 231 zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10) ! delta rho(10m) 232 IF( zztmp > zrho3 ) zrho10_3(ji,jj) = zzdep ! > 0.03 233 IF( zztmp > zdelr(ji,jj) ) zpycn (ji,jj) = zzdep ! > equi. delta T(10m) - 0.2 234 ! 235 END DO 236 END DO 237 END DO 238 239 CALL iom_put( 'mld_dt02', zabs2 ) ! MLD abs(delta t) - 0.2 240 CALL iom_put( 'topthdep', ztm2 ) ! T(10) - 0.2 241 CALL iom_put( 'mldr10_3', zrho10_3 ) ! MLD delta rho(10m) = 0.03 242 CALL iom_put( 'pycndep' , zpycn ) ! MLD delta rho equi. delta T(10m) = 0.2 243 CALL iom_put( 'tinv' , ztinv ) ! max. temp. inv. (t10 ref) 244 CALL iom_put( 'depti' , zdepinv ) ! depth of max. temp. inv. (t10 ref) 245 ! 246 ENDIF 247 248 ! ------------------------------- ! 249 ! Depth of 20C/26C/28C isotherm ! 250 ! ------------------------------- ! 251 IF( iom_use ('20d') ) THEN ! depth of the 20 isotherm 252 ztem2 = 20. 253 CALL dia_hth_dep( Kmm, ztem2, hd20 ) 254 CALL iom_put( '20d', hd20 ) 255 ENDIF 256 ! 257 IF( iom_use ('26d') ) THEN ! depth of the 26 isotherm 258 ztem2 = 26. 259 CALL dia_hth_dep( Kmm, ztem2, hd26 ) 260 CALL iom_put( '26d', hd26 ) 261 ENDIF 262 ! 263 IF( iom_use ('28d') ) THEN ! depth of the 28 isotherm 264 ztem2 = 28. 265 CALL dia_hth_dep( Kmm, ztem2, hd28 ) 266 CALL iom_put( '28d', hd28 ) 267 ENDIF 268 269 ! ----------------------------- ! 270 ! Heat content of first 300 m ! 271 ! ----------------------------- ! 272 IF( iom_use ('hc300') ) THEN 273 zzdep = 300. 274 CALL dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc3 ) 275 CALL iom_put( 'hc300', rau0_rcp * htc3 ) ! vertically integrated heat content (J/m2) 276 ENDIF 277 ! 278 ! ----------------------------- ! 279 ! Heat content of first 700 m ! 280 ! ----------------------------- ! 281 IF( iom_use ('hc700') ) THEN 282 zzdep = 700. 283 CALL dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc7 ) 284 CALL iom_put( 'hc700', rau0_rcp * htc7 ) ! vertically integrated heat content (J/m2) 285 286 ENDIF 287 ! 288 ! ----------------------------- ! 289 ! Heat content of first 2000 m ! 290 ! ----------------------------- ! 291 IF( iom_use ('hc2000') ) THEN 292 zzdep = 2000. 293 CALL dia_hth_htc( Kmm, zzdep, ts(:,:,:,jp_tem,Kmm), htc20 ) 294 CALL iom_put( 'hc2000', rau0_rcp * htc20 ) ! vertically integrated heat content (J/m2) 295 ENDIF 296 ! 158 297 ENDIF 298 299 ! 300 IF( ln_timing ) CALL timing_stop('dia_hth') 301 ! 302 END SUBROUTINE dia_hth 303 304 SUBROUTINE dia_hth_dep( Kmm, ptem, pdept ) 305 ! 306 INTEGER , INTENT(in) :: Kmm ! ocean time level index 307 REAL(wp), INTENT(in) :: ptem 308 REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: pdept 309 ! 310 INTEGER :: ji, jj, jk, iid 311 REAL(wp) :: zztmp, zzdep 312 INTEGER, DIMENSION(jpi,jpj) :: iktem 159 313 160 ! Preliminary computation 161 ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) 162 DO jj = 1, jpj 163 DO ji = 1, jpi 164 IF( tmask(ji,jj,nla10) == 1. ) THEN 165 zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) & 166 & - 0.0745 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) & 167 & - 0.0100 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_sal,Kmm) 168 zv = 5891.00 + 38.000 * ts(ji,jj,nla10,jp_tem,Kmm) + 3.00 * ts(ji,jj,nla10,jp_sal,Kmm) & 169 & - 0.3750 * ts(ji,jj,nla10,jp_tem,Kmm) * ts(ji,jj,nla10,jp_tem,Kmm) 170 zut = 11.25 - 0.149 * ts(ji,jj,nla10,jp_tem,Kmm) - 0.01 * ts(ji,jj,nla10,jp_sal,Kmm) 171 zvt = 38.00 - 0.750 * ts(ji,jj,nla10,jp_tem,Kmm) 172 zw = (zu + 0.698*zv) * (zu + 0.698*zv) 173 zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 174 ELSE 175 zdelr(ji,jj) = 0._wp 176 ENDIF 177 END DO 178 END DO 179 180 ! ------------------------------------------------------------- ! 181 ! thermocline depth: strongest vertical gradient of temperature ! 182 ! turbocline depth (mixing layer depth): avt = zavt5 ! 183 ! MLD: rho = rho(1) + zrho3 ! 184 ! MLD: rho = rho(1) + zrho1 ! 185 ! ------------------------------------------------------------- ! 186 DO jk = jpkm1, 2, -1 ! loop from bottom to 2 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 ! 190 zzdep = gdepw(ji,jj,jk,Kmm) 191 zztmp = ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) / zzdep * tmask(ji,jj,jk) ! vertical gradient of temperature (dT/dz) 192 zzdep = zzdep * tmask(ji,jj,1) 193 194 IF( zztmp > zmaxdzT(ji,jj) ) THEN 195 zmaxdzT(ji,jj) = zztmp ; hth (ji,jj) = zzdep ! max and depth of dT/dz 196 ENDIF 197 198 IF( nla10 > 1 ) THEN 199 zztmp = rhop(ji,jj,jk) - rhop(ji,jj,1) ! delta rho(1) 200 IF( zztmp > zrho3 ) zrho0_3(ji,jj) = zzdep ! > 0.03 201 IF( zztmp > zrho1 ) zrho0_1(ji,jj) = zzdep ! > 0.01 202 ENDIF 203 204 END DO 205 END DO 206 END DO 207 208 CALL iom_put( "mlddzt", hth ) ! depth of the thermocline 209 IF( nla10 > 1 ) THEN 210 CALL iom_put( "mldr0_3", zrho0_3 ) ! MLD delta rho(surf) = 0.03 211 CALL iom_put( "mldr0_1", zrho0_1 ) ! MLD delta rho(surf) = 0.01 212 ENDIF 213 214 ! ------------------------------------------------------------- ! 215 ! MLD: abs( tn - tn(10m) ) = ztem2 ! 216 ! Top of thermocline: tn = tn(10m) - ztem2 ! 217 ! MLD: rho = rho10m + zrho3 ! 218 ! pycnocline: rho = rho10m + (dr/dT)(T,S,10m)*(-0.2 degC) ! 219 ! temperature inversion: max( 0, max of tn - tn(10m) ) ! 220 ! depth of temperature inversion ! 221 ! ------------------------------------------------------------- ! 222 DO jk = jpkm1, nlb10, -1 ! loop from bottom to nlb10 223 DO jj = 1, jpj 224 DO ji = 1, jpi 225 ! 226 zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) 227 ! 228 zztmp = ts(ji,jj,nla10,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ! - delta T(10m) 229 IF( ABS(zztmp) > ztem2 ) zabs2 (ji,jj) = zzdep ! abs > 0.2 230 IF( zztmp > ztem2 ) ztm2 (ji,jj) = zzdep ! > 0.2 231 zztmp = -zztmp ! delta T(10m) 232 IF( zztmp > ztinv(ji,jj) ) THEN ! temperature inversion 233 ztinv(ji,jj) = zztmp ; zdepinv (ji,jj) = zzdep ! max value and depth 234 ENDIF 235 236 zztmp = rhop(ji,jj,jk) - rhop(ji,jj,nla10) ! delta rho(10m) 237 IF( zztmp > zrho3 ) zrho10_3(ji,jj) = zzdep ! > 0.03 238 IF( zztmp > zdelr(ji,jj) ) zpycn (ji,jj) = zzdep ! > equi. delta T(10m) - 0.2 239 ! 240 END DO 241 END DO 242 END DO 243 244 CALL iom_put( "mld_dt02", zabs2 ) ! MLD abs(delta t) - 0.2 245 CALL iom_put( "topthdep", ztm2 ) ! T(10) - 0.2 246 CALL iom_put( "mldr10_3", zrho10_3 ) ! MLD delta rho(10m) = 0.03 247 CALL iom_put( "pycndep" , zpycn ) ! MLD delta rho equi. delta T(10m) = 0.2 248 CALL iom_put( "tinv" , ztinv ) ! max. temp. inv. (t10 ref) 249 CALL iom_put( "depti" , zdepinv ) ! depth of max. temp. inv. (t10 ref) 250 251 252 ! ----------------------------------- ! 253 ! search deepest level above 20C/28C ! 254 ! ----------------------------------- ! 255 ik20(:,:) = 1 256 ik28(:,:) = 1 314 ! --------------------------------------- ! 315 ! search deepest level above ptem ! 316 ! --------------------------------------- ! 317 iktem(:,:) = 1 257 318 DO jk = 1, jpkm1 ! beware temperature is not always decreasing with depth => loop from top to bottom 258 319 DO jj = 1, jpj 259 320 DO ji = 1, jpi 260 321 zztmp = ts(ji,jj,jk,jp_tem,Kmm) 261 IF( zztmp >= 20. ) ik20(ji,jj) = jk 262 IF( zztmp >= 28. ) ik28(ji,jj) = jk 322 IF( zztmp >= ptem ) iktem(ji,jj) = jk 263 323 END DO 264 324 END DO 265 325 END DO 266 326 267 ! --------------------------- !268 ! Depth of 20C/28C isotherm!269 ! --------------------------- !327 ! ------------------------------- ! 328 ! Depth of ptem isotherm ! 329 ! ------------------------------- ! 270 330 DO jj = 1, jpj 271 331 DO ji = 1, jpi 272 332 ! 273 zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the o ean bottom333 zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the ocean bottom 274 334 ! 275 iid = ik 20(ji,jj)335 iid = iktem(ji,jj) 276 336 IF( iid /= 1 ) THEN 277 zztmp =gdept(ji,jj,iid ,Kmm) & ! linear interpolation337 zztmp = gdept(ji,jj,iid ,Kmm) & ! linear interpolation 278 338 & + ( gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm) ) & 279 339 & * ( 20.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm) ) & 280 340 & / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) ) 281 hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1) ! bound by the ocean depth341 pdept(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1) ! bound by the ocean depth 282 342 ELSE 283 hd20(ji,jj) = 0._wp343 pdept(ji,jj) = 0._wp 284 344 ENDIF 285 !286 iid = ik28(ji,jj)287 IF( iid /= 1 ) THEN288 zztmp = gdept(ji,jj,iid ,Kmm) & ! linear interpolation289 & + ( gdept(ji,jj,iid+1,Kmm) - gdept(ji,jj,iid,Kmm) ) &290 & * ( 28.*tmask(ji,jj,iid+1) - ts(ji,jj,iid,jp_tem,Kmm) ) &291 & / ( ts(ji,jj,iid+1,jp_tem,Kmm) - ts(ji,jj,iid,jp_tem,Kmm) + (1.-tmask(ji,jj,1)) )292 hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1) ! bound by the ocean depth293 ELSE294 hd28(ji,jj) = 0._wp295 ENDIF296 297 345 END DO 298 346 END DO 299 CALL iom_put( "20d", hd20 ) ! depth of the 20 isotherm 300 CALL iom_put( "28d", hd28 ) ! depth of the 28 isotherm 301 302 ! ----------------------------- ! 303 ! Heat content of first 300 m ! 304 ! ----------------------------- ! 305 306 ! find ilevel with (ilevel+1) the deepest W-level above 300m (we assume we can use e3t_1d to do this search...) 307 ilevel = 0 308 zthick_0 = 0._wp 309 DO jk = 1, jpkm1 310 zthick_0 = zthick_0 + e3t_1d(jk) 311 IF( zthick_0 < 300. ) ilevel = jk 312 END DO 347 ! 348 END SUBROUTINE dia_hth_dep 349 350 351 SUBROUTINE dia_hth_htc( Kmm, pdep, pt, phtc ) 352 ! 353 INTEGER , INTENT(in) :: Kmm ! ocean time level index 354 REAL(wp), INTENT(in) :: pdep ! depth over the heat content 355 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: pt 356 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: phtc 357 ! 358 INTEGER :: ji, jj, jk, ik 359 REAL(wp), DIMENSION(jpi,jpj) :: zthick 360 INTEGER , DIMENSION(jpi,jpj) :: ilevel 361 362 313 363 ! surface boundary condition 314 IF( ln_linssh ) THEN ; zthick(:,:) = ssh(:,:,Kmm) ; htc3(:,:) = ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) * tmask(:,:,1) 315 ELSE ; zthick(:,:) = 0._wp ; htc3(:,:) = 0._wp 364 365 IF( .NOT. ln_linssh ) THEN ; zthick(:,:) = 0._wp ; phtc(:,:) = 0._wp 366 ELSE ; zthick(:,:) = ssh(:,:,Kmm) ; phtc(:,:) = pt(:,:,1) * ssh(:,:,Kmm) * tmask(:,:,1) 316 367 ENDIF 317 ! integration down to ilevel 318 DO jk = 1, ilevel 319 zthick(:,:) = zthick(:,:) + e3t(:,:,jk,Kmm) 320 htc3 (:,:) = htc3 (:,:) + e3t(:,:,jk,Kmm) * ts(:,:,jk,jp_tem,Kmm) * tmask(:,:,jk) 321 END DO 322 ! deepest layer 323 zthick(:,:) = 300. - zthick(:,:) ! remaining thickness to reach 300m 368 ! 369 ilevel(:,:) = 1 370 DO jk = 2, jpkm1 371 DO jj = 1, jpj 372 DO ji = 1, jpi 373 IF( ( gdept(ji,jj,jk,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN 374 ilevel(ji,jj) = jk 375 zthick(ji,jj) = zthick(ji,jj) + e3t(ji,jj,jk,Kmm) 376 phtc (ji,jj) = phtc (ji,jj) + e3t(ji,jj,jk,Kmm) * pt(ji,jj,jk) 377 ENDIF 378 ENDDO 379 ENDDO 380 ENDDO 381 ! 324 382 DO jj = 1, jpj 325 383 DO ji = 1, jpi 326 htc3(ji,jj) = htc3(ji,jj) + ts(ji,jj,ilevel+1,jp_tem,Kmm) & 327 & * MIN( e3t(ji,jj,ilevel+1,Kmm), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 384 ik = ilevel(ji,jj) 385 zthick(ji,jj) = pdep - zthick(ji,jj) ! remaining thickness to reach depht pdep 386 phtc(ji,jj) = phtc(ji,jj) + pt(ji,jj,ik+1) * MIN( e3t(ji,jj,ik+1,Kmm), zthick(ji,jj) ) & 387 * tmask(ji,jj,ik+1) 328 388 END DO 329 END DO 330 ! from temperature to heat contain 331 zcoef = rau0 * rcp 332 htc3(:,:) = zcoef * htc3(:,:) 333 CALL iom_put( "hc300", htc3 ) ! first 300m heat content 334 ! 335 IF( ln_timing ) CALL timing_stop('dia_hth') 336 ! 337 END SUBROUTINE dia_hth 338 339 #else 340 !!---------------------------------------------------------------------- 341 !! Default option : Empty module 342 !!---------------------------------------------------------------------- 343 LOGICAL , PUBLIC, PARAMETER :: lk_diahth = .FALSE. !: thermocline-20d depths flag 344 CONTAINS 345 SUBROUTINE dia_hth( kt, Kmm ) ! Empty routine 346 IMPLICIT NONE 347 INTEGER, INTENT( in ) :: kt 348 INTEGER, INTENT( in ) :: Kmm 349 WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt 350 END SUBROUTINE dia_hth 351 #endif 389 ENDDO 390 ! 391 ! 392 END SUBROUTINE dia_hth_htc 352 393 353 394 !!====================================================================== -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diaptr.F90
r11960 r12193 10 10 !! 3.6 ! 2014-12 (C. Ethe) use of IOM 11 11 !! 3.6 ! 2016-06 (T. Graham) Addition of diagnostics for CMIP6 12 !! 4.0 ! 2010-08 ( C. Ethe, J. Deshayes ) Improvment 12 13 !!---------------------------------------------------------------------- 13 14 … … 42 43 43 44 ! !!** namelist namptr ** 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf, htr_eiv !: Heat TRansports (adv, diff, Bolus.) 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv !: Salt TRansports (adv, diff, Bolus.) 46 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_ove, str_ove !: heat Salt TRansports ( overturn.) 47 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_btr, str_btr !: heat Salt TRansports ( barotropic ) 48 49 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 50 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 51 INTEGER, PUBLIC :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 47 48 LOGICAL , PUBLIC :: l_diaptr !: tracers trend flag (set from namelist in trdini) 49 INTEGER, PARAMETER, PUBLIC :: nptr = 5 ! (glo, atl, pac, ind, ipc) 52 50 53 51 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup 54 52 REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rau0 x Cp) 55 REAL(wp) :: rc_ggram = 1.e- 6_wp ! conversion from g to Pg56 57 CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:) :: clsubb58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 60 61 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(: ) :: p_fval1d62 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 63 53 REAL(wp) :: rc_ggram = 1.e-9_wp ! conversion from g to Gg (further x rau0) 54 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S) 57 58 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:) :: p_fval1d 59 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 60 61 LOGICAL :: ll_init = .TRUE. !: tracers trend flag (set from namelist in trdini) 64 62 !! * Substitutions 65 63 # include "vectopt_loop_substitute.h90" … … 71 69 CONTAINS 72 70 73 SUBROUTINE dia_ptr( Kmm, pvtr )71 SUBROUTINE dia_ptr( kt, Kmm, pvtr ) 74 72 !!---------------------------------------------------------------------- 75 73 !! *** ROUTINE dia_ptr *** 76 74 !!---------------------------------------------------------------------- 75 INTEGER , INTENT(in) :: kt ! ocean time-step index 77 76 INTEGER , INTENT(in) :: Kmm ! time level index 78 77 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport … … 81 80 REAL(wp) :: zsfc,zvfc ! local scalar 82 81 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace84 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 85 84 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 86 REAL(wp), DIMENSION(jpj) :: vsum ! 1D workspace 87 REAL(wp), DIMENSION(jpj,jpts) :: tssum ! 1D workspace 88 85 REAL(wp), DIMENSION(jpj) :: zvsum, ztsum, zssum ! 1D workspace 89 86 ! 90 87 !overturning calculation 91 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 92 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvv ! 3D workspace 94 95 96 CHARACTER( len = 12 ) :: cl1 88 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse 89 REAL(wp), DIMENSION(jpj,jpk,nptr) :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 90 91 REAL(wp), DIMENSION(jpi,jpj,jpk,nptr) :: z4d1, z4d2 92 REAL(wp), DIMENSION(jpi,jpj,nptr) :: z3dtr ! i-mean T and S, j-Stream-Function 97 93 !!---------------------------------------------------------------------- 98 94 ! 99 95 IF( ln_timing ) CALL timing_start('dia_ptr') 100 96 101 ! 97 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init 98 ! 99 IF( .NOT. l_diaptr ) RETURN 100 102 101 IF( PRESENT( pvtr ) ) THEN 103 IF( iom_use("zomsfglo") ) THEN ! effective MSF 104 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) ) ! zonal cumulative effective transport 105 DO jk = 2, jpkm1 106 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 102 IF( iom_use( 'zomsf' ) ) THEN ! effective MSF 103 DO jn = 1, nptr ! by sub-basins 104 z4d1(1,:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) ! zonal cumulative effective transport excluding closed seas 105 DO jk = jpkm1, 1, -1 106 z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn) ! effective j-Stream-Function (MSF) 107 END DO 108 DO ji = 1, jpi 109 z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 110 ENDDO 107 111 END DO 108 DO ji = 1, jpi 109 z3d(ji,:,:) = z3d(1,:,:) 110 ENDDO 111 cl1 = TRIM('zomsf'//clsubb(1) ) 112 CALL iom_put( cl1, z3d * rc_sv ) 113 DO jn = 2, nptr ! by sub-basins 114 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 115 DO jk = 2, jpkm1 116 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 117 END DO 118 DO ji = 1, jpi 119 z3d(ji,:,:) = z3d(1,:,:) 120 ENDDO 121 cl1 = TRIM('zomsf'//clsubb(jn) ) 122 CALL iom_put( cl1, z3d * rc_sv ) 123 END DO 124 ENDIF 125 IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 112 CALL iom_put( 'zomsf', z4d1 * rc_sv ) 113 ENDIF 114 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 115 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 126 116 ! define fields multiplied by scalar 127 117 zmask(:,:,:) = 0._wp 128 118 zts(:,:,:,:) = 0._wp 129 zvv(:,:,:) = 0._wp130 119 DO jk = 1, jpkm1 131 120 DO jj = 1, jpjm1 … … 135 124 zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc !Tracers averaged onto V grid 136 125 zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 137 zvv(ji,jj,jk) = vv(ji,jj,jk,Kmm) * zvfc138 126 ENDDO 139 127 ENDDO 140 128 ENDDO 141 129 ENDIF 142 IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 143 sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 144 r1_sjk(:,:,1) = 0._wp 145 WHERE( sjk(:,:,1) /= 0._wp ) r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 146 147 ! i-mean T and S, j-Stream-Function, global 148 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 149 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 150 v_msf(:,:,1) = ptr_sjk( zvv(:,:,:) ) 151 152 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 153 str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 154 155 z2d(1,:) = htr_ove(:,1) * rc_pwatt ! (conversion in PW) 156 DO ji = 1, jpi 157 z2d(ji,:) = z2d(1,:) 158 ENDDO 159 cl1 = 'sophtove' 160 CALL iom_put( TRIM(cl1), z2d ) 161 z2d(1,:) = str_ove(:,1) * rc_ggram ! (conversion in Gg) 162 DO ji = 1, jpi 163 z2d(ji,:) = z2d(1,:) 164 ENDDO 165 cl1 = 'sopstove' 166 CALL iom_put( TRIM(cl1), z2d ) 167 IF( ln_subbas ) THEN 168 DO jn = 2, nptr 169 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 170 r1_sjk(:,:,jn) = 0._wp 171 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 172 173 ! i-mean T and S, j-Stream-Function, basin 174 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 175 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 176 v_msf(:,:,jn) = ptr_sjk( zvv(:,:,:), btmsk(:,:,jn) ) 177 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 178 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 179 180 z2d(1,:) = htr_ove(:,jn) * rc_pwatt ! (conversion in PW) 181 DO ji = 1, jpi 182 z2d(ji,:) = z2d(1,:) 183 ENDDO 184 cl1 = TRIM('sophtove_'//clsubb(jn)) 185 CALL iom_put( cl1, z2d ) 186 z2d(1,:) = str_ove(:,jn) * rc_ggram ! (conversion in Gg) 187 DO ji = 1, jpi 188 z2d(ji,:) = z2d(1,:) 189 ENDDO 190 cl1 = TRIM('sopstove_'//clsubb(jn)) 191 CALL iom_put( cl1, z2d ) 192 END DO 193 ENDIF 194 ENDIF 195 IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 196 ! Calculate barotropic heat and salt transport here 197 sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 198 r1_sjk(:,1,1) = 0._wp 199 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 200 201 vsum = ptr_sj( zvv(:,:,:), btmsk(:,:,1)) 202 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 203 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 204 htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 205 str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 206 z2d(1,:) = htr_btr(:,1) * rc_pwatt ! (conversion in PW) 207 DO ji = 2, jpi 208 z2d(ji,:) = z2d(1,:) 209 ENDDO 210 cl1 = 'sophtbtr' 211 CALL iom_put( TRIM(cl1), z2d ) 212 z2d(1,:) = str_btr(:,1) * rc_ggram ! (conversion in Gg) 213 DO ji = 2, jpi 214 z2d(ji,:) = z2d(1,:) 215 ENDDO 216 cl1 = 'sopstbtr' 217 CALL iom_put( TRIM(cl1), z2d ) 218 IF( ln_subbas ) THEN 219 DO jn = 2, nptr 220 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 221 r1_sjk(:,1,jn) = 0._wp 222 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 223 vsum = ptr_sj( zvv(:,:,:), btmsk(:,:,jn)) 224 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 225 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 226 htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 227 str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 228 z2d(1,:) = htr_btr(:,jn) * rc_pwatt ! (conversion in PW) 229 DO ji = 1, jpi 230 z2d(ji,:) = z2d(1,:) 231 ENDDO 232 cl1 = TRIM('sophtbtr_'//clsubb(jn)) 233 CALL iom_put( cl1, z2d ) 234 z2d(1,:) = str_btr(:,jn) * rc_ggram ! (conversion in Gg) 235 DO ji = 1, jpi 236 z2d(ji,:) = z2d(1,:) 237 ENDDO 238 cl1 = TRIM('sopstbtr_'//clsubb(jn)) 239 CALL iom_put( cl1, z2d ) 240 ENDDO 241 ENDIF !ln_subbas 242 ENDIF !iom_use("sopstbtr....) 130 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 131 DO jn = 1, nptr 132 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 133 r1_sjk(:,:,jn) = 0._wp 134 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 135 ! i-mean T and S, j-Stream-Function, basin 136 zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 137 zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 138 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 139 hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 140 hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 141 ! 142 ENDDO 143 DO jn = 1, nptr 144 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 145 DO ji = 1, jpi 146 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 147 ENDDO 148 ENDDO 149 CALL iom_put( 'sophtove', z3dtr ) 150 DO jn = 1, nptr 151 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 152 DO ji = 1, jpi 153 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 154 ENDDO 155 ENDDO 156 CALL iom_put( 'sopstove', z3dtr ) 157 ENDIF 158 159 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 160 ! Calculate barotropic heat and salt transport here 161 DO jn = 1, nptr 162 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 163 r1_sjk(:,1,jn) = 0._wp 164 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 165 ! 166 zvsum(:) = ptr_sj( pvtr(:,:,:), btmsk34(:,:,jn) ) 167 ztsum(:) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 168 zssum(:) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 169 hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 170 hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 171 ! 172 ENDDO 173 DO jn = 1, nptr 174 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 175 DO ji = 1, jpi 176 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 177 ENDDO 178 ENDDO 179 CALL iom_put( 'sophtbtr', z3dtr ) 180 DO jn = 1, nptr 181 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 182 DO ji = 1, jpi 183 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 184 ENDDO 185 ENDDO 186 CALL iom_put( 'sopstbtr', z3dtr ) 187 ENDIF 243 188 ! 244 189 ELSE 245 190 ! 246 IF( iom_use("zotemglo") ) THEN ! i-mean i-k-surface 191 zmask(:,:,:) = 0._wp 192 zts(:,:,:,:) = 0._wp 193 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 247 194 DO jk = 1, jpkm1 248 195 DO jj = 1, jpj … … 255 202 END DO 256 203 END DO 204 ! 257 205 DO jn = 1, nptr 258 206 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 259 cl1 = TRIM('zosrf'//clsubb(jn) ) 260 CALL iom_put( cl1, zmask ) 261 ! 262 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 263 & / MAX( zmask(1,:,:), 10.e-15 ) 264 DO ji = 1, jpi 265 z3d(ji,:,:) = z3d(1,:,:) 266 ENDDO 267 cl1 = TRIM('zotem'//clsubb(jn) ) 268 CALL iom_put( cl1, z3d ) 269 ! 270 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 271 & / MAX( zmask(1,:,:), 10.e-15 ) 272 DO ji = 1, jpi 273 z3d(ji,:,:) = z3d(1,:,:) 274 ENDDO 275 cl1 = TRIM('zosal'//clsubb(jn) ) 276 CALL iom_put( cl1, z3d ) 277 END DO 207 z4d1(:,:,:,jn) = zmask(:,:,:) 208 ENDDO 209 CALL iom_put( 'zosrf', z4d1 ) 210 ! 211 DO jn = 1, nptr 212 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 213 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) 214 DO ji = 1, jpi 215 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 216 ENDDO 217 ENDDO 218 CALL iom_put( 'zotem', z4d2 ) 219 ! 220 DO jn = 1, nptr 221 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 222 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) 223 DO ji = 1, jpi 224 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 225 ENDDO 226 ENDDO 227 CALL iom_put( 'zosal', z4d2 ) 228 ! 278 229 ENDIF 279 230 ! 280 231 ! ! Advective and diffusive heat and salt transport 281 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 282 z2d(1,:) = htr_adv(:,1) * rc_pwatt ! (conversion in PW) 283 DO ji = 1, jpi 284 z2d(ji,:) = z2d(1,:) 285 ENDDO 286 cl1 = 'sophtadv' 287 CALL iom_put( TRIM(cl1), z2d ) 288 z2d(1,:) = str_adv(:,1) * rc_ggram ! (conversion in Gg) 289 DO ji = 1, jpi 290 z2d(ji,:) = z2d(1,:) 291 ENDDO 292 cl1 = 'sopstadv' 293 CALL iom_put( TRIM(cl1), z2d ) 294 IF( ln_subbas ) THEN 295 DO jn=2,nptr 296 z2d(1,:) = htr_adv(:,jn) * rc_pwatt ! (conversion in PW) 297 DO ji = 1, jpi 298 z2d(ji,:) = z2d(1,:) 299 ENDDO 300 cl1 = TRIM('sophtadv_'//clsubb(jn)) 301 CALL iom_put( cl1, z2d ) 302 z2d(1,:) = str_adv(:,jn) * rc_ggram ! (conversion in Gg) 303 DO ji = 1, jpi 304 z2d(ji,:) = z2d(1,:) 305 ENDDO 306 cl1 = TRIM('sopstadv_'//clsubb(jn)) 307 CALL iom_put( cl1, z2d ) 308 ENDDO 309 ENDIF 310 ENDIF 311 ! 312 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 313 z2d(1,:) = htr_ldf(:,1) * rc_pwatt ! (conversion in PW) 314 DO ji = 1, jpi 315 z2d(ji,:) = z2d(1,:) 316 ENDDO 317 cl1 = 'sophtldf' 318 CALL iom_put( TRIM(cl1), z2d ) 319 z2d(1,:) = str_ldf(:,1) * rc_ggram ! (conversion in Gg) 320 DO ji = 1, jpi 321 z2d(ji,:) = z2d(1,:) 322 ENDDO 323 cl1 = 'sopstldf' 324 CALL iom_put( TRIM(cl1), z2d ) 325 IF( ln_subbas ) THEN 326 DO jn=2,nptr 327 z2d(1,:) = htr_ldf(:,jn) * rc_pwatt ! (conversion in PW) 328 DO ji = 1, jpi 329 z2d(ji,:) = z2d(1,:) 330 ENDDO 331 cl1 = TRIM('sophtldf_'//clsubb(jn)) 332 CALL iom_put( cl1, z2d ) 333 z2d(1,:) = str_ldf(:,jn) * rc_ggram ! (conversion in Gg) 334 DO ji = 1, jpi 335 z2d(ji,:) = z2d(1,:) 336 ENDDO 337 cl1 = TRIM('sopstldf_'//clsubb(jn)) 338 CALL iom_put( cl1, z2d ) 339 ENDDO 340 ENDIF 341 ENDIF 342 343 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 344 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 345 DO ji = 1, jpi 346 z2d(ji,:) = z2d(1,:) 347 ENDDO 348 cl1 = 'sophteiv' 349 CALL iom_put( TRIM(cl1), z2d ) 350 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 351 DO ji = 1, jpi 352 z2d(ji,:) = z2d(1,:) 353 ENDDO 354 cl1 = 'sopsteiv' 355 CALL iom_put( TRIM(cl1), z2d ) 356 IF( ln_subbas ) THEN 357 DO jn=2,nptr 358 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 232 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 233 ! 234 DO jn = 1, nptr 235 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 236 DO ji = 1, jpi 237 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 238 ENDDO 239 ENDDO 240 CALL iom_put( 'sophtadv', z3dtr ) 241 DO jn = 1, nptr 242 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 243 DO ji = 1, jpi 244 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 245 ENDDO 246 ENDDO 247 CALL iom_put( 'sopstadv', z3dtr ) 248 ENDIF 249 ! 250 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 251 ! 252 DO jn = 1, nptr 253 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 254 DO ji = 1, jpi 255 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 256 ENDDO 257 ENDDO 258 CALL iom_put( 'sophtldf', z3dtr ) 259 DO jn = 1, nptr 260 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 261 DO ji = 1, jpi 262 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 263 ENDDO 264 ENDDO 265 CALL iom_put( 'sopstldf', z3dtr ) 266 ENDIF 267 ! 268 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 269 ! 270 DO jn = 1, nptr 271 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 272 DO ji = 1, jpi 273 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 274 ENDDO 275 ENDDO 276 CALL iom_put( 'sophteiv', z3dtr ) 277 DO jn = 1, nptr 278 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 279 DO ji = 1, jpi 280 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 281 ENDDO 282 ENDDO 283 CALL iom_put( 'sopsteiv', z3dtr ) 284 ENDIF 285 ! 286 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 287 zts(:,:,:,:) = 0._wp 288 DO jk = 1, jpkm1 289 DO jj = 1, jpjm1 359 290 DO ji = 1, jpi 360 z2d(ji,:) = z2d(1,:) 291 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 292 zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc !Tracers averaged onto V grid 293 zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 361 294 ENDDO 362 cl1 = TRIM('sophteiv_'//clsubb(jn)) 363 CALL iom_put( cl1, z2d ) 364 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 365 DO ji = 1, jpi 366 z2d(ji,:) = z2d(1,:) 367 ENDDO 368 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 369 CALL iom_put( cl1, z2d ) 370 ENDDO 371 ENDIF 295 ENDDO 296 ENDDO 297 CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 298 CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 299 DO jn = 1, nptr 300 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 301 DO ji = 1, jpi 302 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 303 ENDDO 304 ENDDO 305 CALL iom_put( 'sophtvtr', z3dtr ) 306 DO jn = 1, nptr 307 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 308 DO ji = 1, jpi 309 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 310 ENDDO 311 ENDDO 312 CALL iom_put( 'sopstvtr', z3dtr ) 313 ENDIF 314 ! 315 IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 316 CALL iom_get_var( 'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 317 z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 318 CALL iom_put( 'uocetr_vsum_cumul', z2d ) 372 319 ENDIF 373 320 ! … … 385 332 !! ** Purpose : Initialization, namelist read 386 333 !!---------------------------------------------------------------------- 387 INTEGER :: jn ! local integers388 INTEGER :: inum, ierr ! local integers389 INTEGER :: ios ! Local integer output status for namelist read390 !! 391 NAMELIST/namptr/ ln_diaptr, ln_subbas 392 !!----------------------------------------------------------------------393 394 READ ( numnam_ref, namptr, IOSTAT = ios, ERR = 901)395 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist' ) 396 397 READ ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 )398 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist' ) 399 IF(lwm) WRITE ( numond, namptr ) 400 334 INTEGER :: inum, jn ! local integers 335 !! 336 REAL(wp), DIMENSION(jpi,jpj) :: zmsk 337 !!---------------------------------------------------------------------- 338 339 l_diaptr = .FALSE. 340 IF( iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 341 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 342 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 343 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 344 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 345 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) ) l_diaptr = .TRUE. 346 347 401 348 IF(lwp) THEN ! Control print 402 349 WRITE(numout,*) … … 404 351 WRITE(numout,*) '~~~~~~~~~~~~' 405 352 WRITE(numout,*) ' Namelist namptr : set ptr parameters' 406 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr 407 WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins ln_subbas = ', ln_subbas 353 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) l_diaptr = ', l_diaptr 408 354 ENDIF 409 355 410 IF( ln_diaptr ) THEN 411 ! 412 IF( ln_subbas ) THEN 413 nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 414 ALLOCATE( clsubb(nptr) ) 415 clsubb(1) = 'glo' ; clsubb(2) = 'atl' ; clsubb(3) = 'pac' ; clsubb(4) = 'ind' ; clsubb(5) = 'ipc' 416 ELSE 417 nptr = 1 ! Global only 418 ALLOCATE( clsubb(nptr) ) 419 clsubb(1) = 'glo' 420 ENDIF 421 422 ! ! allocate dia_ptr arrays 356 IF( l_diaptr ) THEN 357 ! 423 358 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 424 359 425 360 rc_pwatt = rc_pwatt * rau0_rcp ! conversion from K.s-1 to PetaWatt 361 rc_ggram = rc_ggram * rau0 ! conversion from m3/s to Gg/s 426 362 427 363 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 428 364 429 IF( ln_subbas ) THEN ! load sub-basin mask 430 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 431 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 432 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 433 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 434 CALL iom_close( inum ) 435 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 436 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 437 ELSE WHERE ; btm30(:,:) = ssmask(:,:) 438 END WHERE 439 ENDIF 440 441 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 442 443 DO jn = 1, nptr 365 btmsk(:,:,1) = tmask_i(:,:) 366 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 367 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 368 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 369 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 370 CALL iom_close( inum ) 371 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 372 DO jn = 2, nptr 444 373 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 445 374 END DO 375 ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations 376 WHERE( gphit(:,:)*tmask_i(:,:) < -34._wp) 377 zmsk(:,:) = 0._wp ! mask out Southern Ocean 378 ELSE WHERE 379 zmsk(:,:) = ssmask(:,:) 380 END WHERE 381 btmsk34(:,:,1) = btmsk(:,:,1) 382 DO jn = 2, nptr 383 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only 384 ENDDO 446 385 447 386 ! Initialise arrays to zero because diatpr is called before they are first calculated 448 387 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 449 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 450 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 451 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 452 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 453 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 388 hstr_adv(:,:,:) = 0._wp 389 hstr_ldf(:,:,:) = 0._wp 390 hstr_eiv(:,:,:) = 0._wp 391 hstr_ove(:,:,:) = 0._wp 392 hstr_btr(:,:,:) = 0._wp ! 393 hstr_vtr(:,:,:) = 0._wp ! 394 ! 395 ll_init = .FALSE. 454 396 ! 455 397 ENDIF … … 470 412 INTEGER :: jn ! 471 413 414 ! 472 415 IF( cptr == 'adv' ) THEN 473 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pvflx ) 474 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pvflx ) 416 IF( ktra == jp_tem ) THEN 417 DO jn = 1, nptr 418 hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 419 ENDDO 420 ENDIF 421 IF( ktra == jp_sal ) THEN 422 DO jn = 1, nptr 423 hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 424 ENDDO 425 ENDIF 475 426 ENDIF 427 ! 476 428 IF( cptr == 'ldf' ) THEN 477 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pvflx ) 478 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pvflx ) 429 IF( ktra == jp_tem ) THEN 430 DO jn = 1, nptr 431 hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 432 ENDDO 433 ENDIF 434 IF( ktra == jp_sal ) THEN 435 DO jn = 1, nptr 436 hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 437 ENDDO 438 ENDIF 479 439 ENDIF 440 ! 480 441 IF( cptr == 'eiv' ) THEN 481 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pvflx ) 482 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pvflx ) 442 IF( ktra == jp_tem ) THEN 443 DO jn = 1, nptr 444 hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 445 ENDDO 446 ENDIF 447 IF( ktra == jp_sal ) THEN 448 DO jn = 1, nptr 449 hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 450 ENDDO 451 ENDIF 483 452 ENDIF 484 453 ! 485 IF( ln_subbas ) THEN 486 ! 487 IF( cptr == 'adv' ) THEN 488 IF( ktra == jp_tem ) THEN 489 DO jn = 2, nptr 490 htr_adv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 491 END DO 492 ENDIF 493 IF( ktra == jp_sal ) THEN 494 DO jn = 2, nptr 495 str_adv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 496 END DO 497 ENDIF 498 ENDIF 499 IF( cptr == 'ldf' ) THEN 500 IF( ktra == jp_tem ) THEN 501 DO jn = 2, nptr 502 htr_ldf(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 503 END DO 504 ENDIF 505 IF( ktra == jp_sal ) THEN 506 DO jn = 2, nptr 507 str_ldf(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 508 END DO 509 ENDIF 510 ENDIF 511 IF( cptr == 'eiv' ) THEN 512 IF( ktra == jp_tem ) THEN 513 DO jn = 2, nptr 514 htr_eiv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 515 END DO 516 ENDIF 517 IF( ktra == jp_sal ) THEN 518 DO jn = 2, nptr 519 str_eiv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 520 END DO 521 ENDIF 522 ENDIF 523 ! 454 IF( cptr == 'vtr' ) THEN 455 IF( ktra == jp_tem ) THEN 456 DO jn = 1, nptr 457 hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 458 ENDDO 459 ENDIF 460 IF( ktra == jp_sal ) THEN 461 DO jn = 1, nptr 462 hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 463 ENDDO 464 ENDIF 524 465 ENDIF 466 ! 525 467 END SUBROUTINE dia_ptr_hst 526 468 … … 535 477 ierr(:) = 0 536 478 ! 537 ALLOCATE( btmsk(jpi,jpj,nptr) , & 538 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 539 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 540 & htr_ove(jpj,nptr) , str_ove(jpj,nptr) , & 541 & htr_btr(jpj,nptr) , str_btr(jpj,nptr) , & 542 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 543 ! 544 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 545 ! 546 ALLOCATE( btm30(jpi,jpj), STAT=ierr(3) ) 547 548 ! 549 dia_ptr_alloc = MAXVAL( ierr ) 550 CALL mpp_sum( 'diaptr', dia_ptr_alloc ) 479 IF( .NOT. ALLOCATED( btmsk ) ) THEN 480 ALLOCATE( btmsk(jpi,jpj,nptr) , btmsk34(jpi,jpj,nptr), & 481 & hstr_adv(jpj,jpts,nptr), hstr_eiv(jpj,jpts,nptr), & 482 & hstr_ove(jpj,jpts,nptr), hstr_btr(jpj,jpts,nptr), & 483 & hstr_ldf(jpj,jpts,nptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1) ) 484 ! 485 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 486 ! 487 dia_ptr_alloc = MAXVAL( ierr ) 488 CALL mpp_sum( 'diaptr', dia_ptr_alloc ) 489 ENDIF 551 490 ! 552 491 END FUNCTION dia_ptr_alloc … … 564 503 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 565 504 !!---------------------------------------------------------------------- 566 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvflx! mask flux array at V-point567 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL:: pmsk ! Optional 2D basin mask505 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvflx ! mask flux array at V-point 506 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 568 507 ! 569 508 INTEGER :: ji, jj, jk ! dummy loop arguments … … 576 515 ijpj = jpj 577 516 p_fval(:) = 0._wp 578 IF( PRESENT( pmsk ) ) THEN 579 DO jk = 1, jpkm1 580 DO jj = 2, jpjm1 581 DO ji = fs_2, fs_jpim1 ! Vector opt. 582 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 583 END DO 517 DO jk = 1, jpkm1 518 DO jj = 2, jpjm1 519 DO ji = fs_2, fs_jpim1 ! Vector opt. 520 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 584 521 END DO 585 522 END DO 586 ELSE 587 DO jk = 1, jpkm1 588 DO jj = 2, jpjm1 589 DO ji = fs_2, fs_jpim1 ! Vector opt. 590 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * tmask_i(ji,jj) 591 END DO 592 END DO 593 END DO 594 ENDIF 523 END DO 595 524 #if defined key_mpp_mpi 596 525 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) … … 611 540 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 612 541 !!---------------------------------------------------------------------- 613 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pvflx! mask flux array at V-point614 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL:: pmsk ! Optional 2D basin mask542 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pvflx ! mask flux array at V-point 543 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 615 544 ! 616 545 INTEGER :: ji,jj ! dummy loop arguments … … 623 552 ijpj = jpj 624 553 p_fval(:) = 0._wp 625 IF( PRESENT( pmsk ) ) THEN 626 DO jj = 2, jpjm1 627 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 628 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 629 END DO 554 DO jj = 2, jpjm1 555 DO ji = fs_2, fs_jpim1 ! Vector opt. 556 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 630 557 END DO 631 ELSE 632 DO jj = 2, jpjm1 633 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 634 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * tmask_i(ji,jj) 635 END DO 636 END DO 637 ENDIF 558 END DO 638 559 #if defined key_mpp_mpi 639 560 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) … … 642 563 END FUNCTION ptr_sj_2d 643 564 644 645 FUNCTION ptr_sjk( pfld, pmsk ) RESULT ( p_fval ) 565 FUNCTION ptr_ci_2d( pva ) RESULT ( p_fval ) 566 !!---------------------------------------------------------------------- 567 !! *** ROUTINE ptr_ci_2d *** 568 !! 569 !! ** Purpose : "meridional" cumulated sum computation of a j-flux array 570 !! 571 !! ** Method : - j cumulated sum of pva using the interior 2D vmask (umask_i). 572 !! 573 !! ** Action : - p_fval: j-cumulated sum of pva 574 !!---------------------------------------------------------------------- 575 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 576 ! 577 INTEGER :: ji,jj,jc ! dummy loop arguments 578 INTEGER :: ijpj ! ??? 579 REAL(wp), DIMENSION(jpi,jpj) :: p_fval ! function value 580 !!-------------------------------------------------------------------- 581 ! 582 ijpj = jpj ! ??? 583 p_fval(:,:) = 0._wp 584 DO jc = 1, jpnj ! looping over all processors in j axis 585 DO jj = 2, jpjm1 586 DO ji = fs_2, fs_jpim1 ! Vector opt. 587 p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 588 END DO 589 END DO 590 CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. ) 591 END DO 592 ! 593 END FUNCTION ptr_ci_2d 594 595 596 597 FUNCTION ptr_sjk( pta, pmsk ) RESULT ( p_fval ) 646 598 !!---------------------------------------------------------------------- 647 599 !! *** ROUTINE ptr_sjk *** … … 655 607 !! 656 608 IMPLICIT none 657 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pfld ! input field to be summed658 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL:: pmsk ! Optional 2D basin mask609 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! mask flux array at V-point 610 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 659 611 !! 660 612 INTEGER :: ji, jj, jk ! dummy loop arguments … … 672 624 p_fval(:,:) = 0._wp 673 625 ! 674 IF( PRESENT( pmsk ) ) THEN 675 DO jk = 1, jpkm1 676 DO jj = 2, jpjm1 677 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 678 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 679 p_fval(jj,jk) = p_fval(jj,jk) + pfld(ji,jj,jk) * pmsk(ji,jj) 680 END DO 626 DO jk = 1, jpkm1 627 DO jj = 2, jpjm1 628 DO ji = fs_2, fs_jpim1 ! Vector opt. 629 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 681 630 END DO 682 631 END DO 683 ELSE 684 DO jk = 1, jpkm1 685 DO jj = 2, jpjm1 686 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 687 p_fval(jj,jk) = p_fval(jj,jk) + pfld(ji,jj,jk) * tmask_i(ji,jj) 688 END DO 689 END DO 690 END DO 691 END IF 632 END DO 692 633 ! 693 634 #if defined key_mpp_mpi -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/IOM/iom.F90
r12182 r12193 55 55 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 56 56 #endif 57 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 57 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var 58 58 PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 59 59 PUBLIC iom_use, iom_context_finalize, iom_miss_val … … 61 61 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 62 62 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 63 PRIVATE iom_p1d, iom_p2d, iom_p3d 63 PRIVATE iom_p1d, iom_p2d, iom_p3d, iom_p4d 64 64 #if defined key_iomput 65 65 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr … … 82 82 END INTERFACE 83 83 INTERFACE iom_put 84 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 84 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d, iom_p4d 85 85 END INTERFACE iom_put 86 86 … … 107 107 TYPE(xios_date) :: start_date 108 108 CHARACTER(len=lc) :: clname 109 INTEGER :: irefyear, irefmonth, irefday 109 110 INTEGER :: ji, jkmin 110 111 LOGICAL :: llrst_context ! is context related to restart … … 139 140 140 141 ! Calendar type is now defined in xml file 142 IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear = 1900 143 IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01 144 IF (.NOT.(xios_getvar('ref_day' ,irefday ))) irefday = 01 145 141 146 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 142 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date( 1900,01,01,00,00,00), &147 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 143 148 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 144 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date( 1900,01,01,00,00,00), &149 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 145 150 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 146 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date( 1900,01,01,00,00,00), &151 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 147 152 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 148 153 END SELECT … … 241 246 CALL iom_set_axis_attr( "icbcla", class_num ) 242 247 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) ! strange syntaxe and idea... 248 CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) ) ! strange syntaxe and idea... 243 249 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) ! strange syntaxe and idea... 250 CALL iom_set_axis_attr( "basin" , (/ (REAL(ji,wp), ji=1,5) /) ) 244 251 ENDIF 245 252 ! … … 1348 1355 END SUBROUTINE iom_get_123d 1349 1356 1357 SUBROUTINE iom_get_var( cdname, z2d) 1358 CHARACTER(LEN=*), INTENT(in ) :: cdname 1359 REAL(wp), DIMENSION(jpi,jpj) :: z2d 1360 #if defined key_iomput 1361 IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN 1362 z2d(:,:) = 0._wp 1363 CALL xios_recv_field( cdname, z2d) 1364 ENDIF 1365 #else 1366 IF( .FALSE. ) WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings 1367 #endif 1368 END SUBROUTINE iom_get_var 1369 1350 1370 1351 1371 FUNCTION iom_getszuld ( kiomid ) … … 1717 1737 END SUBROUTINE iom_p3d 1718 1738 1739 SUBROUTINE iom_p4d( cdname, pfield4d ) 1740 CHARACTER(LEN=*) , INTENT(in) :: cdname 1741 REAL(wp), DIMENSION(:,:,:,:), INTENT(in) :: pfield4d 1742 #if defined key_iomput 1743 CALL xios_send_field(cdname, pfield4d) 1744 #else 1745 IF( .FALSE. ) WRITE(numout,*) cdname, pfield4d ! useless test to avoid compilation warnings 1746 #endif 1747 END SUBROUTINE iom_p4d 1748 1749 1719 1750 #if defined key_iomput 1720 1751 !!---------------------------------------------------------------------- … … 2059 2090 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 2060 2091 ! 2061 CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots)2062 !CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)2092 ! CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 2093 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 2063 2094 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 2064 2095 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 2065 2096 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 2066 2097 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 2067 CALL iom_set_zoom_domain_attr("znl_T", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 2068 CALL iom_set_zoom_domain_attr("znl_W", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 2098 CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 2069 2099 ! 2070 2100 CALL iom_update_file_name('ptr') -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/LDF/ldftra.F90
r12150 r12193 851 851 CALL iom_put( "woce_eiv", zw3d ) 852 852 ! 853 IF( iom_use('weiv_masstr') ) THEN ! vertical mass transport & its square value 854 zw2d(:,:) = rau0 * e1e2t(:,:) 855 DO jk = 1, jpk 856 zw3d(:,:,jk) = zw3d(:,:,jk) * zw2d(:,:) 857 END DO 858 CALL iom_put( "weiv_masstr" , zw3d ) 859 ENDIF 860 ! 861 IF( iom_use('ueiv_masstr') ) THEN 862 zw3d(:,:,:) = 0.e0 863 DO jk = 1, jpkm1 864 zw3d(:,:,jk) = rau0 * ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) 865 END DO 866 CALL iom_put( "ueiv_masstr", zw3d ) ! mass transport in i-direction 867 ENDIF 853 868 ! 854 869 zztmp = 0.5_wp * rau0 * rcp … … 870 885 CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in i-direction 871 886 ENDIF 887 ! 888 IF( iom_use('veiv_masstr') ) THEN 889 zw3d(:,:,:) = 0.e0 890 DO jk = 1, jpkm1 891 zw3d(:,:,jk) = rau0 * ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) 892 END DO 893 CALL iom_put( "veiv_masstr", zw3d ) ! mass transport in i-direction 894 ENDIF 895 ! 872 896 zw2d(:,:) = 0._wp 873 897 zw3d(:,:,:) = 0._wp … … 885 909 CALL iom_put( "veiv_heattr", zztmp * zw3d ) ! heat transport in j-direction 886 910 ! 887 IF( ln_diaptr )CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d )911 IF( iom_use( 'sophteiv' ) ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d ) 888 912 ! 889 913 zztmp = 0.5_wp * 0.5 … … 920 944 CALL iom_put( "veiv_salttr", zztmp * zw3d ) ! salt transport in j-direction 921 945 ! 922 IF( ln_diaptr) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d )946 IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) 923 947 ! 924 948 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcblk.F90
r12182 r12193 979 979 REAL(wp), DIMENSION(jpi,jpj) :: zevap, zsnw ! evaporation and snw distribution after wind blowing (SI3) 980 980 REAL(wp), DIMENSION(jpi,jpj) :: zqair ! specific humidity of air at z=rn_zqt [kg/kg] !LB 981 REAL(wp), DIMENSION(jpi,jpj) :: ztmp, ztmp2 981 982 !!--------------------------------------------------------------------- 982 983 ! … … 1102 1103 END WHERE 1103 1104 ! 1105 1106 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) THEN 1107 ztmp(:,:) = zevap(:,:) * ( 1._wp - at_i_b(:,:) ) 1108 IF( iom_use('evap_ao_cea' ) ) CALL iom_put( 'evap_ao_cea' , ztmp(:,:) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1109 IF( iom_use('hflx_evap_cea') ) CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * sst_m(:,:) * rcp * tmask(:,:,1) ) ! heat flux from evap (cell average) 1110 ENDIF 1111 IF( iom_use('hflx_rain_cea') ) THEN 1112 ztmp(:,:) = rcp * ( SUM( (ptsu-rt0) * a_i_b, dim=3 ) + sst_m(:,:) * ( 1._wp - at_i_b(:,:) ) ) 1113 IF( iom_use('hflx_rain_cea') ) CALL iom_put( 'hflx_rain_cea', ( tprecip(:,:) - sprecip(:,:) ) * ztmp(:,:) ) ! heat flux from rain (cell average) 1114 ENDIF 1115 IF( iom_use('hflx_snow_cea') .OR. iom_use('hflx_snow_ao_cea') .OR. iom_use('hflx_snow_ai_cea') ) THEN 1116 WHERE( SUM( a_i_b, dim=3 ) > 1.e-10 ) ; ztmp(:,:) = rcpi * SUM( (ptsu-rt0) * a_i_b, dim=3 ) / SUM( a_i_b, dim=3 ) 1117 ELSEWHERE ; ztmp(:,:) = rcp * sst_m(:,:) 1118 ENDWHERE 1119 ztmp2(:,:) = sprecip(:,:) * ( ztmp(:,:) - rLfus ) 1120 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , ztmp2(:,:) ) ! heat flux from snow (cell average) 1121 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', ztmp2(:,:) * ( 1._wp - zsnw(:,:) ) ) ! heat flux from snow (over ocean) 1122 IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', ztmp2(:,:) * zsnw(:,:) ) ! heat flux from snow (over ice) 1123 ENDIF 1124 ! 1104 1125 IF(ln_ctl) THEN 1105 1126 CALL prt_ctl(tab3d_1=qla_ice , clinfo1=' blk_ice: qla_ice : ', tab3d_2=z_qsb , clinfo2=' z_qsb : ', kdim=jpl) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbccpl.F90
r12182 r12193 1777 1777 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1778 1778 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1779 IF( iom_use('rain_ao_cea') ) CALL iom_put( 'rain_ao_cea' , ( tprecip(:,:) - sprecip(:,:) ) * picefr(:,:) ) ! liquid precipitation over ocean (cell average) 1779 1780 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1780 1781 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & … … 1905 1906 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea' , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 1906 1907 & * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) ) ! heat flux from evap (cell average) 1908 IF( iom_use('hflx_prec_cea') ) CALL iom_put('hflx_prec_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) + & ! heat flux from all precip (cell avg) 1909 & ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) 1907 1910 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea' , sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) ) ! heat flux from snow (cell average) 1908 1911 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & … … 2305 2308 ! ! CO2 flux from PISCES ! 2306 2309 ! ! ------------------------- ! 2307 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) CALL cpl_snd( jps_co2, isec, RESHAPE ( oce_co2, (/jpi,jpj,1/) ) , info ) 2310 IF( ssnd(jps_co2)%laction .AND. l_co2cpl ) THEN 2311 ztmp1(:,:) = oce_co2(:,:) * 1000. ! conversion in molC/m2/s 2312 CALL cpl_snd( jps_co2, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ) , info ) 2313 ENDIF 2308 2314 ! 2309 2315 ! ! ------------------------- ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcmod.F90
r12182 r12193 246 246 #endif 247 247 ! 248 ! 249 IF( sbc_ssr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_ssr arrays' ) 250 IF( .NOT.ln_ssr ) THEN !* Initialize qrp and erp if no restoring 251 qrp(:,:) = 0._wp 252 erp(:,:) = 0._wp 253 ENDIF 254 ! 255 248 256 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 249 257 IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case … … 559 567 CALL iom_put( "taum" , taum ) ! wind stress module 560 568 CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice 569 CALL iom_put( "qrp", qrp ) ! heat flux damping 570 CALL iom_put( "erp", erp ) ! freshwater flux damping 561 571 ENDIF 562 572 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcrnf.F90
r12182 r12193 42 42 REAL(wp) :: rn_dep_max !: depth over which runoffs is spread (ln_rnf_depth_ini =T) 43 43 INTEGER :: nn_rnf_depth_file !: create (=1) a runoff depth file or not (=0) 44 LOGICAL :: ln_rnf_icb !: iceberg flux is specified in a file 44 45 LOGICAL :: ln_rnf_tem !: temperature river runoffs attribute specified in a file 45 46 LOGICAL , PUBLIC :: ln_rnf_sal !: salinity river runoffs attribute specified in a file 46 47 TYPE(FLD_N) , PUBLIC :: sn_rnf !: information about the runoff file to be read 47 48 TYPE(FLD_N) :: sn_cnf !: information about the runoff mouth file to be read 49 TYPE(FLD_N) :: sn_i_rnf !: information about the iceberg flux file to be read 48 50 TYPE(FLD_N) :: sn_s_rnf !: information about the salinities of runoff file to be read 49 51 TYPE(FLD_N) :: sn_t_rnf !: information about the temperatures of runoff file to be read … … 64 66 65 67 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read) 68 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_i_rnf ! structure: iceberg flux (file information, fields read) 66 69 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read) 67 70 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read) … … 111 114 ! !-------------------! 112 115 ! 113 IF( .NOT. l_rnfcpl ) CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt 116 ! 117 IF( .NOT. l_rnfcpl ) THEN 118 CALL fld_read ( kt, nn_fsbc, sf_rnf ) ! Read Runoffs data and provide it at kt ( runoffs + iceberg ) 119 IF( ln_rnf_icb ) CALL fld_read ( kt, nn_fsbc, sf_i_rnf ) ! idem for iceberg flux if required 120 ENDIF 114 121 IF( ln_rnf_tem ) CALL fld_read ( kt, nn_fsbc, sf_t_rnf ) ! idem for runoffs temperature if required 115 122 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required … … 117 124 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 118 125 ! 119 IF( .NOT. l_rnfcpl ) rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 126 IF( .NOT. l_rnfcpl ) THEN 127 rnf(:,:) = rn_rfact * ( sf_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 128 IF( ln_rnf_icb ) THEN 129 fwficb(:,:) = rn_rfact * ( sf_i_rnf(1)%fnow(:,:,1) ) * tmask(:,:,1) ! updated runoff value at time step kt 130 CALL iom_put( 'iceberg_cea' , fwficb(:,:) ) ! output iceberg flux 131 CALL iom_put( 'hflx_icb_cea' , fwficb(:,:) * rLfus ) ! output Heat Flux into Sea Water due to Iceberg Thermodynamics --> 132 ENDIF 133 ENDIF 120 134 ! 121 135 ! ! set temperature & salinity content of runoffs … … 128 142 ELSE ! use SST as runoffs temperature 129 143 !CEOD River is fresh water so must at least be 0 unless we consider ice 130 rnf_tsc(:,:,jp_tem) = MAX( sst_m(:,:),0.0_wp) * rnf(:,:) * r1_rau0144 rnf_tsc(:,:,jp_tem) = MAX( sst_m(:,:), 0.0_wp ) * rnf(:,:) * r1_rau0 131 145 ENDIF 132 146 ! ! use runoffs salinity data 133 147 IF( ln_rnf_sal ) rnf_tsc(:,:,jp_sal) = ( sf_s_rnf(1)%fnow(:,:,1) ) * rnf(:,:) * r1_rau0 134 148 ! ! else use S=0 for runoffs (done one for all in the init) 135 IF( iom_use('runoffs') )CALL iom_put( 'runoffs' , rnf(:,:) ) ! output runoff mass flux149 CALL iom_put( 'runoffs' , rnf(:,:) ) ! output runoff mass flux 136 150 IF( iom_use('hflx_rnf_cea') ) CALL iom_put( 'hflx_rnf_cea', rnf_tsc(:,:,jp_tem) * rau0 * rcp ) ! output runoff sensible heat (W/m2) 137 151 ENDIF … … 240 254 REAL(wp), DIMENSION(jpi,jpj,2) :: zrnfcl 241 255 !! 242 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, &243 & sn_rnf, sn_cnf , sn_ s_rnf , sn_t_rnf , sn_dep_rnf, &256 NAMELIST/namsbc_rnf/ cn_dir , ln_rnf_depth, ln_rnf_tem, ln_rnf_sal, ln_rnf_icb, & 257 & sn_rnf, sn_cnf , sn_i_rnf, sn_s_rnf , sn_t_rnf , sn_dep_rnf, & 244 258 & ln_rnf_mouth , rn_hrnf , rn_avt_rnf, rn_rfact, & 245 259 & ln_rnf_depth_ini , rn_dep_max , rn_rnf_max, nn_rnf_depth_file … … 295 309 IF( sn_rnf%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 296 310 CALL fld_fill( sf_rnf, (/ sn_rnf /), cn_dir, 'sbc_rnf_init', 'read runoffs data', 'namsbc_rnf', no_print ) 311 ! 312 IF( ln_rnf_icb ) THEN ! Create (if required) sf_i_rnf structure 313 IF(lwp) WRITE(numout,*) 314 IF(lwp) WRITE(numout,*) ' iceberg flux read in a file' 315 ALLOCATE( sf_i_rnf(1), STAT=ierror ) 316 IF( ierror > 0 ) THEN 317 CALL ctl_stop( 'sbc_rnf_init: unable to allocate sf_i_rnf structure' ) ; RETURN 318 ENDIF 319 ALLOCATE( sf_i_rnf(1)%fnow(jpi,jpj,1) ) 320 IF( sn_i_rnf%ln_tint ) ALLOCATE( sf_i_rnf(1)%fdta(jpi,jpj,1,2) ) 321 CALL fld_fill (sf_i_rnf, (/ sn_i_rnf /), cn_dir, 'sbc_rnf_init', 'read iceberg flux data', 'namsbc_rnf' ) 322 ELSE 323 fwficb(:,:) = 0._wp 324 ENDIF 325 297 326 ENDIF 298 327 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/SBC/sbcssr.F90
r11960 r12193 30 30 PUBLIC sbc_ssr ! routine called in sbcmod 31 31 PUBLIC sbc_ssr_init ! routine called in sbcmod 32 PUBLIC sbc_ssr_alloc ! routine called in sbcmod 32 33 33 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s] 34 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qrp !: heat flux damping [w/m2] 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: coefice !: under ice relaxation coefficient 35 37 36 38 ! !!* Namelist namsbc_ssr * … … 41 43 LOGICAL :: ln_sssr_bnd ! flag to bound erp term 42 44 REAL(wp) :: rn_sssr_bnd ! ABS(Max./Min.) value of erp term [mm/day] 45 INTEGER :: nn_sssr_ice ! Control of restoring under ice 43 46 44 47 REAL(wp) , ALLOCATABLE, DIMENSION(:) :: buffer ! Temporary buffer for exchange … … 97 100 END DO 98 101 END DO 99 CALL iom_put( "qrp", qrp ) ! heat flux damping 102 ENDIF 103 ! 104 IF( nn_sssr /= 0 .AND. nn_sssr_ice /= 1 ) THEN 105 ! use fraction of ice ( fr_i ) to adjust relaxation under ice if nn_sssr_ice .ne. 1 106 ! n.b. coefice is initialised and fixed to 1._wp if nn_sssr_ice = 1 107 DO jj = 1, jpj 108 DO ji = 1, jpi 109 SELECT CASE ( nn_sssr_ice ) 110 CASE ( 0 ) ; coefice(ji,jj) = 1._wp - fr_i(ji,jj) ! no/reduced damping under ice 111 CASE DEFAULT ; coefice(ji,jj) = 1._wp + ( nn_sssr_ice - 1 ) * fr_i(ji,jj) ! reinforced damping (x nn_sssr_ice) under ice ) 112 END SELECT 113 END DO 114 END DO 100 115 ENDIF 101 116 ! … … 105 120 DO ji = 1, jpi 106 121 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 122 & * coefice(ji,jj) & ! Optional control of damping under sea-ice 107 123 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 108 124 sfx(ji,jj) = sfx(ji,jj) + zerp ! salt flux … … 110 126 END DO 111 127 END DO 112 CALL iom_put( "erp", erp ) ! freshwater flux damping113 128 ! 114 129 ELSEIF( nn_sssr == 2 ) THEN !* Salinity damping term (volume flux (emp) and associated heat flux (qns) … … 118 133 DO ji = 1, jpi 119 134 zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) ) & ! No damping in vicinity of river mouths 135 & * coefice(ji,jj) & ! Optional control of damping under sea-ice 120 136 & * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) ) & 121 137 & / MAX( sss_m(ji,jj), 1.e-20 ) * tmask(ji,jj,1) … … 126 142 END DO 127 143 END DO 128 CALL iom_put( "erp", erp ) ! freshwater flux damping129 144 ENDIF 130 145 ! … … 154 169 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 155 170 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 156 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 171 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, & 172 & sn_sss, ln_sssr_bnd, rn_sssr_bnd, nn_sssr_ice 157 173 INTEGER :: ios 158 174 !!---------------------------------------------------------------------- … … 180 196 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 181 197 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 182 ENDIF183 !184 ! !* Allocate erp and qrp array185 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )186 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )198 WRITE(numout,*) ' Cntrl of surface restoration under ice nn_sssr_ice = ', nn_sssr_ice 199 WRITE(numout,*) ' ( 0 = no restoration under ice)' 200 WRITE(numout,*) ' ( 1 = restoration everywhere )' 201 WRITE(numout,*) ' (>1 = enhanced restoration under ice )' 202 ENDIF 187 203 ! 188 204 IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays … … 214 230 ENDIF 215 231 ! 232 coefice(:,:) = 1._wp ! Initialise coefice to 1._wp ; will not need to be changed if nn_sssr_ice=1 216 233 ! !* Initialize qrp and erp if no restoring 217 234 IF( nn_sstr /= 1 ) qrp(:,:) = 0._wp … … 219 236 ! 220 237 END SUBROUTINE sbc_ssr_init 238 239 INTEGER FUNCTION sbc_ssr_alloc() 240 !!---------------------------------------------------------------------- 241 !! *** FUNCTION sbc_ssr_alloc *** 242 !!---------------------------------------------------------------------- 243 sbc_ssr_alloc = 0 ! set to zero if no array to be allocated 244 IF( .NOT. ALLOCATED( erp ) ) THEN 245 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), coefice(jpi,jpj), STAT= sbc_ssr_alloc ) 246 ! 247 IF( lk_mpp ) CALL mpp_sum ( 'sbcssr', sbc_ssr_alloc ) 248 IF( sbc_ssr_alloc /= 0 ) CALL ctl_warn('sbc_ssr_alloc: failed to allocate arrays.') 249 ! 250 ENDIF 251 END FUNCTION 221 252 222 253 !!====================================================================== -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traadv.F90
r11960 r12193 136 136 ! 137 137 !!gm ??? 138 IF( ln_diaptr ) CALL dia_ptr( Kmm, zvv )! diagnose the effective MSF138 CALL dia_ptr( kt, Kmm, zvv ) ! diagnose the effective MSF 139 139 !!gm ??? 140 140 ! 141 141 142 IF( l_trdtra ) THEN !* Save ta and sa trends 142 143 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traadv_cen.F90
r11949 r12193 61 61 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 62 62 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 63 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T)63 !! - poleward advective heat and salt transport (l_diaptr=T) 64 64 !!---------------------------------------------------------------------- 65 65 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 89 89 l_hst = .FALSE. 90 90 l_ptr = .FALSE. 91 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) 92 IF( cdtype == 'TRA' .AND. ln_diaptr )l_ptr = .TRUE.91 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 92 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 93 93 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 94 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) 94 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 95 95 ! 96 96 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traadv_fct.F90
r12145 r12193 68 68 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 69 69 !! - send trends to trdtra module for further diagnostics (l_trdtra=T) 70 !! - htr_adv, str_adv :poleward advective heat and salt transport (ln_diaptr=T)70 !! - poleward advective heat and salt transport (ln_diaptr=T) 71 71 !!---------------------------------------------------------------------- 72 72 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 101 101 l_ptr = .FALSE. 102 102 ll_zAimp = .FALSE. 103 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) )l_trd = .TRUE.104 IF( cdtype == 'TRA' .AND. ln_diaptr )l_ptr = .TRUE.105 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. &103 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 104 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 105 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 106 106 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 107 107 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traadv_mus.F90
r11949 r12193 68 68 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 69 69 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 70 !! - htr_adv, str_adv :poleward advective heat and salt transport (ln_diaptr=T)70 !! - poleward advective heat and salt transport (ln_diaptr=T) 71 71 !! 72 72 !! References : Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation … … 120 120 l_ptr = .FALSE. 121 121 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 122 IF( cdtype == 'TRA' .AND. ln_diaptr )l_ptr = .TRUE.122 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 123 123 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 124 124 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traadv_qck.F90
r11949 r12193 21 21 USE trdtra ! trends manager: tracers 22 22 USE diaptr ! poleward transport diagnostics 23 USE iom 23 24 ! 24 25 USE in_out_manager ! I/O manager … … 79 80 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 80 81 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 81 !! - htr_adv, str_adv :poleward advective heat and salt transport (ln_diaptr=T)82 !! - poleward advective heat and salt transport (ln_diaptr=T) 82 83 !! 83 84 !! ** Reference : Leonard (1979, 1991) … … 102 103 l_trd = .FALSE. 103 104 l_ptr = .FALSE. 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) 105 IF( cdtype == 'TRA' .AND. ln_diaptr )l_ptr = .TRUE.105 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 106 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 106 107 ! 107 108 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traadv_ubs.F90
r11949 r12193 79 79 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 80 80 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 81 !! - htr_adv, str_adv :poleward advective heat and salt transport (ln_diaptr=T)81 !! - poleward advective heat and salt transport (ln_diaptr=T) 82 82 !! 83 83 !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. … … 111 111 l_ptr = .FALSE. 112 112 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 113 IF( cdtype == 'TRA' .AND. ln_diaptr )l_ptr = .TRUE.113 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 114 114 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 115 115 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/trabbc.F90
r11960 r12193 102 102 ENDIF 103 103 ! 104 CALL iom_put ( "hfgeou" , rau0_rcp * qgh_trd0(:,:) ) 104 105 IF(ln_ctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 105 106 ! -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traldf_iso.F90
r11949 r12193 125 125 l_hst = .FALSE. 126 126 l_ptr = .FALSE. 127 IF( cdtype == 'TRA' .AND. ln_diaptr )l_ptr = .TRUE.127 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 128 128 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 129 129 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traldf_lap_blp.F90
r11949 r12193 90 90 l_hst = .FALSE. 91 91 l_ptr = .FALSE. 92 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE.92 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 93 93 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 94 94 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traldf_triad.F90
r11949 r12193 111 111 l_hst = .FALSE. 112 112 l_ptr = .FALSE. 113 IF( cdtype == 'TRA' .AND. ln_diaptr )l_ptr = .TRUE.113 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 114 114 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 115 115 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/nemogcm.F90
r12150 r12193 485 485 CALL flo_init( Nnn ) ! drifting Floats 486 486 IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics 487 CALL dia_ptr_init ! Poleward TRansports initialization487 ! CALL dia_ptr_init ! Poleward TRansports initialization 488 488 CALL dia_dct_init ! Sections tranports 489 489 CALL dia_hsb_init( Nnn ) ! heat content, salt content and volume budgets -
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/step.F90
r12150 r12193 196 196 IF(.NOT.ln_linssh) CALL dom_vvl_sf_nxt( kstp, Nbb, Nnn, Naa, kcall=2 ) ! after vertical scale factors (update depth average component) 197 197 ENDIF 198 CALL dyn_zdf( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion ==> after 199 200 IF( ln_dynspg_ts ) THEN 201 CALL wzv ( kstp, Nbb, Nnn, ww, Naa ) ! now cross-level velocity 202 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 198 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion 199 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 200 CALL wzv ( kstp, Nbb, Nnn, ww, Naa ) ! now cross-level velocity 201 IF( ln_zad_Aimp ) CALL wAimp ( kstp, Nnn ) ! Adaptive-implicit vertical advection partitioning 203 202 ENDIF 204 203 … … 212 211 ! diagnostics and outputs 213 212 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 214 IF( ln_floats ) CALL flo_stp ( kstp, Nbb, Nnn ) ! drifting Floats 215 IF( ln_diacfl ) CALL dia_cfl ( kstp, Nnn ) ! Courant number diagnostics 216 IF( lk_diahth ) CALL dia_hth ( kstp, Nnn ) ! Thermocline depth (20 degres isotherm depth) 217 IF( ln_diadct ) CALL dia_dct ( kstp, Nnn ) ! Transports 218 CALL dia_ar5 ( kstp, Nnn ) ! ar5 diag 219 IF( ln_diaharm ) CALL dia_harm( kstp, Nnn ) ! Tidal harmonic analysis 220 CALL dia_wri ( kstp, Nnn ) ! ocean model: outputs 213 IF( ln_floats ) CALL flo_stp ( kstp, Nbb, Nnn ) ! drifting Floats 214 IF( ln_diacfl ) CALL dia_cfl ( kstp, Nnn ) ! Courant number diagnostics 215 CALL dia_hth ( kstp, Nnn ) ! Thermocline depth (20 degres isotherm depth) 216 IF( ln_diadct ) CALL dia_dct ( kstp, Nnn ) ! Transports 217 CALL dia_ar5 ( kstp, Nnn ) ! ar5 diag 218 CALL dia_ptr ( kstp, Nnn ) ! Poleward adv/ldf TRansports diagnostics 219 IF( ln_diaharm ) CALL dia_harm( kstp, Nnn ) ! Tidal harmonic analysis 220 CALL dia_wri ( kstp, Nnn ) ! ocean model: outputs 221 221 ! 222 222 IF( ln_crs ) CALL crs_fld ( kstp, Nnn ) ! ocean model: online field coarsening & output … … 253 253 CALL tra_ldf ( kstp, Nbb, Nnn, ts, Nrhs ) ! lateral mixing 254 254 255 !!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 256 IF( ln_diaptr ) CALL dia_ptr( Nnn ) ! Poleward adv/ldf TRansports diagnostics 257 !!gm 258 CALL tra_zdf ( kstp, Nbb, Nnn, Nrhs, ts, Naa ) ! vert. mixing & after tracer ==> after 255 CALL tra_zdf ( kstp, Nbb, Nnn, Nrhs, ts, Naa ) ! vertical mixing and after tracer fields 259 256 IF( ln_zdfnpc ) CALL tra_npc ( kstp, Nnn, Nrhs, ts, Naa ) ! update after fields by non-penetrative convection 260 257
Note: See TracChangeset
for help on using the changeset viewer.