- Timestamp:
- 2020-11-02T10:56:42+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Files:
-
- 9 edited
-
. (modified) (1 prop)
-
src/OCE/DIA/diaar5.F90 (modified) (20 diffs)
-
src/OCE/DIA/diacfl.F90 (modified) (2 diffs)
-
src/OCE/DIA/diadct.F90 (modified) (9 diffs)
-
src/OCE/DIA/diahsb.F90 (modified) (3 diffs)
-
src/OCE/DIA/diahth.F90 (modified) (10 diffs)
-
src/OCE/DIA/diamlr.F90 (modified) (6 diffs)
-
src/OCE/DIA/diaptr.F90 (modified) (40 diffs)
-
src/OCE/DIA/diawri.F90 (modified) (31 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diaar5.F90
r12630 r13710 39 39 !! * Substitutions 40 40 # include "do_loop_substitute.h90" 41 # include "domzgr_substitute.h90" 41 42 !!---------------------------------------------------------------------- 42 43 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 76 77 ! 77 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 78 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z pe, z2d! 2D workspace79 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z rhd , zrhop, ztpot ! 3D workspace79 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2d, zpe ! 2D workspace 80 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z3d, zrhd, ztpot, zgdept ! 3D workspace (zgdept: needed to use the substitute) 80 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 81 82 … … 87 88 IF( l_ar5 ) THEN 88 89 ALLOCATE( zarea_ssh(jpi,jpj), zbotpres(jpi,jpj), z2d(jpi,jpj) ) 89 ALLOCATE( zrhd(jpi,jpj,jpk) , zrhop(jpi,jpj,jpk))90 ALLOCATE( zrhd(jpi,jpj,jpk) ) 90 91 ALLOCATE( ztsn(jpi,jpj,jpk,jpts) ) 91 92 zarea_ssh(:,:) = e1e2t(:,:) * ssh(:,:,Kmm) … … 101 102 zrhd(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 102 103 END DO 104 DO jk = 1, jpk 105 z3d(:,:,jk) = rho0 * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 106 END DO 103 107 CALL iom_put( 'volcello' , zrhd(:,:,:) ) ! WARNING not consistent with CMIP DR where volcello is at ca. 2000 104 CALL iom_put( 'masscello' , rho0 * e3t(:,:,:,Kmm) * tmask(:,:,:) )! ocean mass108 CALL iom_put( 'masscello' , z3d (:,:,:) ) ! ocean mass 105 109 ENDIF 106 110 ! 107 111 IF( iom_use( 'e3tb' ) ) THEN ! bottom layer thickness 108 DO_2D _11_11112 DO_2D( 1, 1, 1, 1 ) 109 113 ikb = mbkt(ji,jj) 110 114 z2d(ji,jj) = e3t(ji,jj,ikb,Kmm) … … 128 132 ztsn(:,:,:,jp_tem) = ts(:,:,:,jp_tem,Kmm) ! thermosteric ssh 129 133 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 130 CALL eos( ztsn, zrhd, gdept(:,:,:,Kmm) ) ! now in situ density using initial salinity 134 ALLOCATE( zgdept(jpi,jpj,jpk) ) 135 DO jk = 1, jpk 136 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 137 END DO 138 CALL eos( ztsn, zrhd, zgdept) ! now in situ density using initial salinity 131 139 ! 132 140 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice … … 136 144 IF( ln_linssh ) THEN 137 145 IF( ln_isfcav ) THEN 138 DO ji = 1, jpi 139 DO jj = 1, jpj 140 iks = mikt(ji,jj) 141 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 142 END DO 143 END DO 146 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 147 iks = mikt(ji,jj) 148 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj) 149 END_2D 144 150 ELSE 145 151 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1) … … 155 161 156 162 ! ! steric sea surface height 157 CALL eos( ts(:,:,:,:,Kmm), zrhd, zrhop, gdept(:,:,:,Kmm) ) ! now in situ and potential density158 zrhop(:,:,jpk) = 0._wp159 CALL iom_put( 'rhop', zrhop )160 !161 163 zbotpres(:,:) = 0._wp ! no atmospheric surface pressure, levitating sea-ice 162 164 DO jk = 1, jpkm1 163 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * zrhd(:,:,jk)165 zbotpres(:,:) = zbotpres(:,:) + e3t(:,:,jk,Kmm) * rhd(:,:,jk) 164 166 END DO 165 167 IF( ln_linssh ) THEN … … 168 170 DO jj = 1,jpj 169 171 iks = mikt(ji,jj) 170 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * zrhd(ji,jj,iks) + riceload(ji,jj)172 zbotpres(ji,jj) = zbotpres(ji,jj) + ssh(ji,jj,Kmm) * rhd(ji,jj,iks) + riceload(ji,jj) 171 173 END DO 172 174 END DO 173 175 ELSE 174 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * zrhd(:,:,1)176 zbotpres(:,:) = zbotpres(:,:) + ssh(:,:,Kmm) * rhd(:,:,1) 175 177 END IF 176 178 END IF … … 184 186 CALL iom_put( 'botpres', zbotpres ) 185 187 ! 188 DEALLOCATE( zgdept ) 189 ! 186 190 ENDIF 187 191 … … 189 193 ! ! Mean density anomalie, temperature and salinity 190 194 ztsn(:,:,:,:) = 0._wp ! ztsn(:,:,1,jp_tem/sal) is used here as 2D Workspace for temperature & salinity 191 DO_3D _11_11(1, jpkm1 )195 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 192 196 zztmp = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) 193 197 ztsn(ji,jj,1,jp_tem) = ztsn(ji,jj,1,jp_tem) + zztmp * ts(ji,jj,jk,jp_tem,Kmm) … … 249 253 IF( iom_use( 'tosmint_pot') ) THEN 250 254 z2d(:,:) = 0._wp 251 DO_3D _11_11(1, jpkm1 )255 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 252 256 z2d(ji,jj) = z2d(ji,jj) + rho0 * e3t(ji,jj,jk,Kmm) * ztpot(ji,jj,jk) 253 257 END_3D … … 270 274 zpe(:,:) = 0._wp 271 275 IF( ln_zdfddm ) THEN 272 DO_3D _11_11(2, jpk )276 DO_3D( 1, 1, 1, 1, 2, jpk ) 273 277 IF( rn2(ji,jj,jk) > 0._wp ) THEN 274 278 zrw = ( gdept(ji,jj,jk,Kmm) - gdepw(ji,jj,jk,Kmm) ) / e3w(ji,jj,jk,Kmm) … … 283 287 END_3D 284 288 ELSE 285 DO_3D _11_11(1, jpk )289 DO_3D( 1, 1, 1, 1, 1, jpk ) 286 290 zpe(ji,jj) = zpe(ji,jj) + avt(ji,jj,jk) * MIN(0._wp,rn2(ji,jj,jk)) * rho0 * e3w(ji,jj,jk,Kmm) 287 291 END_3D … … 293 297 IF( l_ar5 ) THEN 294 298 DEALLOCATE( zarea_ssh , zbotpres, z2d ) 295 DEALLOCATE( zrhd , zrhop )296 299 DEALLOCATE( ztsn ) 297 300 ENDIF … … 319 322 320 323 z2d(:,:) = puflx(:,:,1) 321 DO_3D _00_00(1, jpkm1 )324 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 322 325 z2d(ji,jj) = z2d(ji,jj) + puflx(ji,jj,jk) 323 326 END_3D 324 CALL lbc_lnk( 'diaar5', z2d, 'U', -1. )327 CALL lbc_lnk( 'diaar5', z2d, 'U', -1.0_wp ) 325 328 IF( cptr == 'adv' ) THEN 326 329 IF( ktra == jp_tem ) CALL iom_put( 'uadv_heattr' , rho0_rcp * z2d ) ! advective heat transport in i-direction … … 333 336 ! 334 337 z2d(:,:) = pvflx(:,:,1) 335 DO_3D _00_00(1, jpkm1 )338 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 336 339 z2d(ji,jj) = z2d(ji,jj) + pvflx(ji,jj,jk) 337 340 END_3D 338 CALL lbc_lnk( 'diaar5', z2d, 'V', -1. )341 CALL lbc_lnk( 'diaar5', z2d, 'V', -1.0_wp ) 339 342 IF( cptr == 'adv' ) THEN 340 343 IF( ktra == jp_tem ) CALL iom_put( 'vadv_heattr' , rho0_rcp * z2d ) ! advective heat transport in j-direction … … 367 370 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & 368 371 & iom_use( 'masstot' ) .OR. iom_use( 'temptot' ) .OR. iom_use( 'saltot' ) .OR. & 369 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) ) L_ar5 = .TRUE. 372 & iom_use( 'botpres' ) .OR. iom_use( 'sshthster' ) .OR. iom_use( 'sshsteric' ) .OR. & 373 & iom_use( 'rhop' ) ) L_ar5 = .TRUE. 370 374 371 375 IF( l_ar5 ) THEN … … 379 383 zvol0 (:,:) = 0._wp 380 384 thick0(:,:) = 0._wp 381 DO_3D _11_11( 1, jpkm1)385 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step) 382 386 idep = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 383 387 zvol0 (ji,jj) = zvol0 (ji,jj) + idep * e1e2t(ji,jj) … … 390 394 ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) ) 391 395 CALL iom_open ( 'sali_ref_clim_monthly', inum ) 392 CALL iom_get ( inum, jpdom_ data, 'vosaline' , zsaldta(:,:,:,1), 1 )393 CALL iom_get ( inum, jpdom_ data, 'vosaline' , zsaldta(:,:,:,2), 12 )396 CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,1), 1 ) 397 CALL iom_get ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,2), 12 ) 394 398 CALL iom_close( inum ) 395 399 … … 397 401 sn0(:,:,:) = sn0(:,:,:) * tmask(:,:,:) 398 402 IF( ln_zps ) THEN ! z-coord. partial steps 399 DO_2D _11_11403 DO_2D( 1, 1, 1, 1 ) ! interpolation of salinity at the last ocean level (i.e. the partial step) 400 404 ik = mbkt(ji,jj) 401 405 IF( ik > 1 ) THEN -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diacfl.F90
r12489 r13710 34 34 !! * Substitutions 35 35 # include "do_loop_substitute.h90" 36 # include "domzgr_substitute.h90" 36 37 !!---------------------------------------------------------------------- 37 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 55 56 INTEGER , DIMENSION(3) :: iloc_u , iloc_v , iloc_w , iloc ! workspace 56 57 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zCu_cfl, zCv_cfl, zCw_cfl ! workspace 58 LOGICAL , DIMENSION(jpi,jpj,jpk) :: llmsk 57 59 !!---------------------------------------------------------------------- 58 60 ! 59 61 IF( ln_timing ) CALL timing_start('dia_cfl') 60 62 ! 61 DO_3D_11_11( 1, jpk ) 63 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 64 llmsk(Nie1: jpi,:,:) = .FALSE. 65 llmsk(:, 1:Njs1,:) = .FALSE. 66 llmsk(:,Nje1: jpj,:) = .FALSE. 67 ! 68 DO_3D( 0, 0, 0, 0, 1, jpk ) ! calculate Courant numbers 62 69 zCu_cfl(ji,jj,jk) = ABS( uu(ji,jj,jk,Kmm) ) * rDt / e1u (ji,jj) ! for i-direction 63 70 zCv_cfl(ji,jj,jk) = ABS( vv(ji,jj,jk,Kmm) ) * rDt / e2v (ji,jj) ! for j-direction 64 zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * rDt / e3w(ji,jj,jk,Kmm) ! for k-direction71 zCw_cfl(ji,jj,jk) = ABS( ww(ji,jj,jk) ) * rDt / e3w(ji,jj,jk,Kmm) ! for k-direction 65 72 END_3D 66 73 ! 67 74 ! write outputs 68 IF( iom_use('cfl_cu') ) CALL iom_put( 'cfl_cu', MAXVAL( zCu_cfl, dim=3 ) ) 69 IF( iom_use('cfl_cv') ) CALL iom_put( 'cfl_cv', MAXVAL( zCv_cfl, dim=3 ) ) 70 IF( iom_use('cfl_cw') ) CALL iom_put( 'cfl_cw', MAXVAL( zCw_cfl, dim=3 ) ) 75 IF( iom_use('cfl_cu') ) THEN 76 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 77 CALL iom_put( 'cfl_cu', MAXVAL( zCu_cfl, mask = llmsk, dim=3 ) ) 78 ENDIF 79 IF( iom_use('cfl_cv') ) THEN 80 llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 81 CALL iom_put( 'cfl_cv', MAXVAL( zCv_cfl, mask = llmsk, dim=3 ) ) 82 ENDIF 83 IF( iom_use('cfl_cw') ) THEN 84 llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 85 CALL iom_put( 'cfl_cw', MAXVAL( zCw_cfl, mask = llmsk, dim=3 ) ) 86 ENDIF 71 87 72 88 ! ! calculate maximum values and locations 73 IF( lk_mpp ) THEN 74 CALL mpp_maxloc( 'diacfl', zCu_cfl, umask, zCu_max, iloc_u ) 75 CALL mpp_maxloc( 'diacfl', zCv_cfl, vmask, zCv_max, iloc_v ) 76 CALL mpp_maxloc( 'diacfl', zCw_cfl, wmask, zCw_max, iloc_w ) 77 ELSE 78 iloc = MAXLOC( ABS( zcu_cfl(:,:,:) ) ) 79 iloc_u(1) = iloc(1) + nimpp - 1 80 iloc_u(2) = iloc(2) + njmpp - 1 81 iloc_u(3) = iloc(3) 82 zCu_max = zCu_cfl(iloc(1),iloc(2),iloc(3)) 83 ! 84 iloc = MAXLOC( ABS( zcv_cfl(:,:,:) ) ) 85 iloc_v(1) = iloc(1) + nimpp - 1 86 iloc_v(2) = iloc(2) + njmpp - 1 87 iloc_v(3) = iloc(3) 88 zCv_max = zCv_cfl(iloc(1),iloc(2),iloc(3)) 89 ! 90 iloc = MAXLOC( ABS( zcw_cfl(:,:,:) ) ) 91 iloc_w(1) = iloc(1) + nimpp - 1 92 iloc_w(2) = iloc(2) + njmpp - 1 93 iloc_w(3) = iloc(3) 94 zCw_max = zCw_cfl(iloc(1),iloc(2),iloc(3)) 95 ENDIF 89 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 90 CALL mpp_maxloc( 'diacfl', zCu_cfl, llmsk, zCu_max, iloc_u ) 91 llmsk(Nis0:Nie0,Njs0:Nje0,:) = vmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 92 CALL mpp_maxloc( 'diacfl', zCv_cfl, llmsk, zCv_max, iloc_v ) 93 llmsk(Nis0:Nie0,Njs0:Nje0,:) = wmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 94 CALL mpp_maxloc( 'diacfl', zCw_cfl, llmsk, zCw_max, iloc_w ) 96 95 ! 97 ! ! write out to file 98 IF( lwp ) THEN 96 IF( lwp ) THEN ! write out to file 99 97 WRITE(numcfl,FMT='(2x,i6,3x,a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') kt, 'Max Cu', zCu_max, iloc_u(1), iloc_u(2), iloc_u(3) 100 98 WRITE(numcfl,FMT='(11x, a6,4x,f7.4,1x,i4,1x,i4,1x,i4)') 'Max Cv', zCv_max, iloc_v(1), iloc_v(2), iloc_v(3) -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diadct.F90
r12489 r13710 11 11 !! 3.4 ! 09/2011 (C Bricaud) 12 12 !!---------------------------------------------------------------------- 13 !! does not work with agrif14 13 #if ! defined key_agrif 14 !! ==>> CAUTION: does not work with agrif 15 15 !!---------------------------------------------------------------------- 16 16 !! dia_dct : Compute the transport through a sec. … … 66 66 TYPE SECTION 67 67 CHARACTER(len=60) :: name ! name of the sec 68 LOGICAL :: llstrpond ! true if you want the computation of salt and 69 ! heat transports 68 LOGICAL :: llstrpond ! true if you want the computation of salt and heat transports 70 69 LOGICAL :: ll_ice_section ! ice surface and ice volume computation 71 70 LOGICAL :: ll_date_line ! = T if the section crosses the date-line … … 74 73 INTEGER, DIMENSION(nb_point_max) :: direction ! vector direction of the point in the section 75 74 CHARACTER(len=40),DIMENSION(nb_class_max) :: classname ! characteristics of the class 76 REAL(wp), DIMENSION(nb_class_max) :: zsigi ,&! in-situ density classes (99 if you don't want)77 zsigp ,&! potential density classes (99 if you don't want)78 zsal ,&! salinity classes (99 if you don't want)79 ztem ,&! temperature classes(99 if you don't want)80 75 REAL(wp), DIMENSION(nb_class_max) :: zsigi ! in-situ density classes (99 if you don't want) 76 REAL(wp), DIMENSION(nb_class_max) :: zsigp ! potential density classes (99 if you don't want) 77 REAL(wp), DIMENSION(nb_class_max) :: zsal ! salinity classes (99 if you don't want) 78 REAL(wp), DIMENSION(nb_class_max) :: ztem ! temperature classes(99 if you don't want) 79 REAL(wp), DIMENSION(nb_class_max) :: zlay ! level classes (99 if you don't want) 81 80 REAL(wp), DIMENSION(nb_type_class,nb_class_max) :: transport ! transport output 82 81 REAL(wp) :: slopeSection ! slope of the section … … 90 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d 91 90 91 92 !! * Substitutions 93 # include "domzgr_substitute.h90" 92 94 !!---------------------------------------------------------------------- 93 95 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 95 97 !! Software governed by the CeCILL license (see ./LICENSE) 96 98 !!---------------------------------------------------------------------- 99 97 100 CONTAINS 98 101 … … 409 412 ijloc=ijglo-njmpp+1 ! " 410 413 411 !verify if the point is on the local domain:(1, nlei)*(1,nlej)412 IF( iiloc >= 1 .AND. iiloc <= nlei.AND. &413 ijloc >= 1 .AND. ijloc <= nlej)THEN414 !verify if the point is on the local domain:(1,Nie0)*(1,Nje0) 415 IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. & 416 ijloc >= 1 .AND. ijloc <= Nje0 )THEN 414 417 iptloc = iptloc + 1 ! count local points 415 418 secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates … … 516 519 517 520 !which coordinate shall we verify ? 518 IF ( cdind=='I' )THEN ; itest= nlei; iind=1519 ELSE IF ( cdind=='J' )THEN ; itest= nlej; iind=2521 IF ( cdind=='I' )THEN ; itest=Nie0 ; iind=1 522 ELSE IF ( cdind=='J' )THEN ; itest=Nje0 ; iind=2 520 523 ELSE ; CALL ctl_stop("removepoints :Wrong value for cdind") 521 524 ENDIF … … 1119 1122 !! | | | interpolation between ptab(I,J,K) and ptab(I,J,K+1) 1120 1123 !! | | | zbis = 1121 !! | | | [ e3w (I+1,J,K)*ptab(I,J,K) + ( e3w(I,J,K) - e3w(I+1,J,K) ) * ptab(I,J,K-1) ]1122 !! | | | /[ e3w(I+1,J,K) + e3w(I,J,K) - e3w(I+1,J,K) ]1124 !! | | | [ e3w_n(I+1,J,K,NOW)*ptab(I,J,K) + ( e3w_n(I,J,K,NOW) - e3w_n(I+1,J,K,NOW) ) * ptab(I,J,K-1) ] 1125 !! | | | /[ e3w_n(I+1,J,K,NOW) + e3w_n(I,J,K,NOW) - e3w_n(I+1,J,K,NOW) ] 1123 1126 !! | | | 1124 1127 !! | | | 2. Horizontal interpolation: compute value at U/V point … … 1213 1216 1214 1217 ze3t = e3t(ii2,ij2,kk,Kmm) - e3t(ii1,ij1,kk,Kmm) 1215 zwgt1 = ( e3w(ii2,ij2,kk,Kmm) - e3w(ii1,ij1,kk,Kmm) ) / e3w(ii2,ij2,kk,Kmm) 1216 zwgt2 = ( e3w(ii1,ij1,kk,Kmm) - e3w(ii2,ij2,kk,Kmm) ) / e3w(ii1,ij1,kk,Kmm) 1218 zwgt1 = ( e3w(ii2,ij2,kk,Kmm) - e3w(ii1,ij1,kk,Kmm) ) & 1219 & / e3w(ii2,ij2,kk,Kmm) 1220 zwgt2 = ( e3w(ii1,ij1,kk,Kmm) - e3w(ii2,ij2,kk,Kmm) ) & 1221 & / e3w(ii1,ij1,kk,Kmm) 1217 1222 1218 1223 IF(kk .NE. 1)THEN -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diahsb.F90
r12489 r13710 50 50 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_ini 51 51 52 !! * Substitutions 53 # include "domzgr_substitute.h90" 52 54 !!---------------------------------------------------------------------- 53 55 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 156 158 ! 157 159 DO jk = 1, jpkm1 ! volume variation (calculated with scale factors) 158 zwrk(:,:,jk) = surf(:,:)*e3t(:,:,jk,Kmm)*tmask(:,:,jk) - surf_ini(:,:)*e3t_ini(:,:,jk)*tmask_ini(:,:,jk) 160 zwrk(:,:,jk) = surf (:,:) * e3t (:,:,jk,Kmm)*tmask (:,:,jk) & 161 & - surf_ini(:,:) * e3t_ini(:,:,jk )*tmask_ini(:,:,jk) 159 162 END DO 160 163 zdiff_v2 = glob_sum_full( 'diahsb', zwrk(:,:,:) ) ! glob_sum_full needed as tmask and tmask_ini could be different 161 164 DO jk = 1, jpkm1 ! heat content variation 162 zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) - surf_ini(:,:)*hc_loc_ini(:,:,jk) ) 165 zwrk(:,:,jk) = ( surf (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_tem,Kmm) & 166 & - surf_ini(:,:) * hc_loc_ini(:,:,jk) ) 163 167 END DO 164 168 zdiff_hc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) 165 169 DO jk = 1, jpkm1 ! salt content variation 166 zwrk(:,:,jk) = ( surf(:,:)*e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) - surf_ini(:,:)*sc_loc_ini(:,:,jk) ) 170 zwrk(:,:,jk) = ( surf (:,:) * e3t(:,:,jk,Kmm)*ts(:,:,jk,jp_sal,Kmm) & 171 & - surf_ini(:,:) * sc_loc_ini(:,:,jk) ) 167 172 END DO 168 173 zdiff_sc = glob_sum_full( 'diahsb', zwrk(:,:,:) ) … … 269 274 CALL iom_get( numror, 'frc_wn_s', frc_wn_s, ldxios = lrxios ) 270 275 ENDIF 271 CALL iom_get( numror, jpdom_auto glo, 'surf_ini' , surf_ini , ldxios = lrxios ) ! ice sheet coupling272 CALL iom_get( numror, jpdom_auto glo, 'ssh_ini' , ssh_ini , ldxios = lrxios )273 CALL iom_get( numror, jpdom_auto glo, 'e3t_ini' , e3t_ini , ldxios = lrxios )274 CALL iom_get( numror, jpdom_auto glo, 'tmask_ini' , tmask_ini , ldxios = lrxios )275 CALL iom_get( numror, jpdom_auto glo, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios )276 CALL iom_get( numror, jpdom_auto glo, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios )276 CALL iom_get( numror, jpdom_auto, 'surf_ini' , surf_ini , ldxios = lrxios ) ! ice sheet coupling 277 CALL iom_get( numror, jpdom_auto, 'ssh_ini' , ssh_ini , ldxios = lrxios ) 278 CALL iom_get( numror, jpdom_auto, 'e3t_ini' , e3t_ini , ldxios = lrxios ) 279 CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini , ldxios = lrxios ) 280 CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios ) 281 CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios ) 277 282 IF( ln_linssh ) THEN 278 CALL iom_get( numror, jpdom_auto glo, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lrxios )279 CALL iom_get( numror, jpdom_auto glo, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lrxios )283 CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lrxios ) 284 CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lrxios ) 280 285 ENDIF 281 286 ELSE -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diahth.F90
r12489 r13710 42 42 !! * Substitutions 43 43 # include "do_loop_substitute.h90" 44 # include "domzgr_substitute.h90" 44 45 !!---------------------------------------------------------------------- 45 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 129 130 zdepinv(:,:) = 0._wp 130 131 zmaxdzT(:,:) = 0._wp 131 DO_2D _11_11132 DO_2D( 1, 1, 1, 1 ) 132 133 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 133 134 hth (ji,jj) = zztmp … … 138 139 END_2D 139 140 IF( nla10 > 1 ) THEN 140 DO_2D _11_11141 DO_2D( 1, 1, 1, 1 ) 141 142 zztmp = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 142 143 zrho0_3(ji,jj) = zztmp … … 147 148 ! Preliminary computation 148 149 ! computation of zdelr = (dr/dT)(T,S,10m)*(-0.2 degC) 149 DO_2D _11_11150 DO_2D( 1, 1, 1, 1 ) 150 151 IF( tmask(ji,jj,nla10) == 1. ) THEN 151 152 zu = 1779.50 + 11.250 * ts(ji,jj,nla10,jp_tem,Kmm) - 3.80 * ts(ji,jj,nla10,jp_sal,Kmm) & … … 169 170 ! MLD: rho = rho(1) + zrho1 ! 170 171 ! ------------------------------------------------------------- ! 171 DO_3DS _11_11( jpkm1, 2, -1 )172 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! loop from bottom to 2 172 173 ! 173 174 zzdep = gdepw(ji,jj,jk,Kmm) … … 206 207 ! depth of temperature inversion ! 207 208 ! ------------------------------------------------------------- ! 208 DO_3DS _11_11( jpkm1, nlb10, -1 )209 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! loop from bottom to nlb10 209 210 ! 210 211 zzdep = gdepw(ji,jj,jk,Kmm) * tmask(ji,jj,1) … … 304 305 ! --------------------------------------- ! 305 306 iktem(:,:) = 1 306 DO_3D _11_11( 1, jpkm1 )307 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! beware temperature is not always decreasing with depth => loop from top to bottom 307 308 zztmp = ts(ji,jj,jk,jp_tem,Kmm) 308 309 IF( zztmp >= ptem ) iktem(ji,jj) = jk … … 312 313 ! Depth of ptem isotherm ! 313 314 ! ------------------------------- ! 314 DO_2D _11_11315 DO_2D( 1, 1, 1, 1 ) 315 316 ! 316 317 zzdep = gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ! depth of the ocean bottom … … 350 351 ! 351 352 ilevel(:,:) = 1 352 DO_3D _11_11(2, jpkm1 )353 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) 353 354 IF( ( gdept(ji,jj,jk,Kmm) < pdep ) .AND. ( tmask(ji,jj,jk) == 1 ) ) THEN 354 355 ilevel(ji,jj) = jk … … 358 359 END_3D 359 360 ! 360 DO_2D _11_11361 DO_2D( 1, 1, 1, 1 ) 361 362 ik = ilevel(ji,jj) 362 363 zthick(ji,jj) = pdep - zthick(ji,jj) ! remaining thickness to reach depht pdep 363 phtc(ji,jj) = phtc(ji,jj) + pt(ji,jj,ik+1) * MIN( e3t(ji,jj,ik+1,Kmm), zthick(ji,jj) ) & 364 phtc(ji,jj) = phtc(ji,jj) & 365 & + pt (ji,jj,ik+1) * MIN( e3t(ji,jj,ik+1,Kmm), zthick(ji,jj) ) & 364 366 * tmask(ji,jj,ik+1) 365 367 END_2D -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diamlr.F90
r12642 r13710 4 4 !! Management of the IOM context for multiple-linear-regression analysis 5 5 !!====================================================================== 6 !! History : ! 2019 (S. Mueller)6 !! History : 4.0 ! 2019 (S. Mueller) Original code 7 7 !!---------------------------------------------------------------------- 8 8 9 9 USE par_oce , ONLY : wp, jpi, jpj 10 10 USE phycst , ONLY : rpi 11 USE dom_oce , ONLY : adatrj 12 USE tide_mod 13 ! 11 14 USE in_out_manager , ONLY : lwp, numout, ln_timing 12 15 USE iom , ONLY : iom_put, iom_use, iom_update_file_name 13 USE dom_oce , ONLY : adatrj14 16 USE timing , ONLY : timing_start, timing_stop 15 17 #if defined key_iomput 16 18 USE xios 17 19 #endif 18 USE tide_mod19 20 20 21 IMPLICIT NONE 21 22 PRIVATE 22 23 23 LOGICAL, PUBLIC :: lk_diamlr = .FALSE. 24 LOGICAL, PUBLIC :: lk_diamlr = .FALSE. !: ===>>> NOT a DOCTOR norm name : use l_diamlr 25 ! lk_ is used only for logical controlled by a CPP key 24 26 25 27 PUBLIC :: dia_mlr_init, dia_mlr_iom_init, dia_mlr … … 42 44 !! 43 45 !!---------------------------------------------------------------------- 44 46 ! 45 47 lk_diamlr = .TRUE. 46 48 ! 47 49 IF(lwp) THEN 48 50 WRITE(numout, *) … … 50 52 WRITE(numout, *) '~~~~~~~~~~~~ multiple-linear-regression analysis' 51 53 END IF 52 54 ! 53 55 END SUBROUTINE dia_mlr_init 56 54 57 55 58 SUBROUTINE dia_mlr_iom_init … … 397 400 END SUBROUTINE dia_mlr_iom_init 398 401 402 399 403 SUBROUTINE dia_mlr 400 404 !!---------------------------------------------------------------------- … … 404 408 !! 405 409 !!---------------------------------------------------------------------- 406 407 410 REAL(wp), DIMENSION(jpi,jpj) :: zadatrj2d 411 !!---------------------------------------------------------------------- 408 412 409 413 IF( ln_timing ) CALL timing_start('dia_mlr') … … 412 416 ! (value of adatrj converted to time in units of seconds) 413 417 ! 414 ! A 2-dimensional field of constant value is sent, and subsequently used 415 ! directly or transformed to a scalar or a constant 3-dimensional field as 416 ! required. 418 ! A 2-dimensional field of constant value is sent, and subsequently used directly 419 ! or transformed to a scalar or a constant 3-dimensional field as required. 417 420 zadatrj2d(:,:) = adatrj*86400.0_wp 418 421 IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d) 419 422 ! 420 423 IF( ln_timing ) CALL timing_stop('dia_mlr') 421 424 ! 422 425 END SUBROUTINE dia_mlr 423 426 427 !!====================================================================== 424 428 END MODULE diamlr -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diaptr.F90
r12489 r13710 36 36 END INTERFACE 37 37 38 PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines39 PUBLIC ptr_sjk !40 PUBLIC dia_ptr_init ! call in memogcm41 38 PUBLIC dia_ptr ! call in step module 42 39 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines 43 40 44 ! !!** namelist namptr **45 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 46 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 47 43 48 LOGICAL , PUBLIC :: l_diaptr !: tracers trend flag (set from namelist in trdini) 49 INTEGER, PARAMETER, PUBLIC :: nptr = 5 ! (glo, atl, pac, ind, ipc) 44 LOGICAL, PUBLIC :: l_diaptr !: tracers trend flag 50 45 51 46 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 59 54 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 60 55 61 LOGICAL :: ll_init = .TRUE. !: tracers trend flag (set from namelist in trdini) 56 LOGICAL :: ll_init = .TRUE. !: tracers trend flag 57 62 58 !! * Substitutions 63 59 # include "do_loop_substitute.h90" 60 # include "domzgr_substitute.h90" 64 61 !!---------------------------------------------------------------------- 65 62 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 86 83 ! 87 84 !overturning calculation 88 REAL(wp), DIMENSION( jpj,jpk,nptr) ::sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse89 REAL(wp), DIMENSION( jpj,jpk,nptr) :: zt_jk, zs_jk! i-mean T and S, j-Stream-Function90 91 REAL(wp), DIMENSION( jpi,jpj,jpk,nptr) ::z4d1, z4d292 REAL(wp), DIMENSION( jpi,jpj,nptr) :: z3dtr ! i-mean T and S, j-Stream-Function85 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse 86 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 87 88 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: z4d1, z4d2 89 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: z3dtr 93 90 !!---------------------------------------------------------------------- 94 91 ! 95 92 IF( ln_timing ) CALL timing_start('dia_ptr') 96 93 97 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init 98 ! 99 IF( .NOT. l_diaptr ) RETURN 100 94 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init ! -> will define l_diaptr and nbasin 95 ! 96 IF( .NOT. l_diaptr ) THEN 97 IF( ln_timing ) CALL timing_stop('dia_ptr') 98 RETURN 99 ENDIF 100 ! 101 ALLOCATE( z3dtr(jpi,jpj,nbasin) ) 102 ! 101 103 IF( PRESENT( pvtr ) ) THEN 102 104 IF( iom_use( 'zomsf' ) ) THEN ! effective MSF 103 DO jn = 1, nptr ! by sub-basins 105 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin) ) 106 DO jn = 1, nbasin ! by sub-basins 104 107 z4d1(1,:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) ! zonal cumulative effective transport excluding closed seas 105 108 DO jk = jpkm1, 1, -1 … … 111 114 END DO 112 115 CALL iom_put( 'zomsf', z4d1 * rc_sv ) 116 DEALLOCATE( z4d1 ) 113 117 ENDIF 114 118 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & … … 117 121 zmask(:,:,:) = 0._wp 118 122 zts(:,:,:,:) = 0._wp 119 DO_3D _10_11(1, jpkm1 )123 DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 120 124 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 121 125 zmask(ji,jj,jk) = vmask(ji,jj,jk) * zvfc … … 125 129 ENDIF 126 130 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 127 DO jn = 1, nptr 131 DO jn = 1, nbasin 132 ALLOCATE( sjk(jpj,jpk,nbasin), r1_sjk(jpj,jpk,nbasin), v_msf(jpj,jpk,nbasin), & 133 & zt_jk(jpj,jpk,nbasin), zs_jk(jpj,jpk,nbasin) ) 128 134 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 129 135 r1_sjk(:,:,jn) = 0._wp … … 135 141 hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 136 142 hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 143 DEALLOCATE( sjk, r1_sjk, v_msf, zt_jk, zs_jk ) 137 144 ! 138 145 ENDDO 139 DO jn = 1, n ptr146 DO jn = 1, nbasin 140 147 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 141 148 DO ji = 1, jpi … … 144 151 ENDDO 145 152 CALL iom_put( 'sophtove', z3dtr ) 146 DO jn = 1, n ptr153 DO jn = 1, nbasin 147 154 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 148 155 DO ji = 1, jpi … … 155 162 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 156 163 ! Calculate barotropic heat and salt transport here 157 DO jn = 1, nptr 164 DO jn = 1, nbasin 165 ALLOCATE( sjk(jpj,1,nbasin), r1_sjk(jpj,1,nbasin) ) 158 166 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 159 167 r1_sjk(:,1,jn) = 0._wp … … 165 173 hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 166 174 hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 175 DEALLOCATE( sjk, r1_sjk ) 167 176 ! 168 177 ENDDO 169 DO jn = 1, n ptr178 DO jn = 1, nbasin 170 179 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 171 180 DO ji = 1, jpi … … 174 183 ENDDO 175 184 CALL iom_put( 'sophtbtr', z3dtr ) 176 DO jn = 1, n ptr185 DO jn = 1, nbasin 177 186 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 178 187 DO ji = 1, jpi … … 188 197 zts(:,:,:,:) = 0._wp 189 198 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 190 DO_3D_11_11( 1, jpkm1 ) 199 ALLOCATE( z4d1(jpi,jpj,jpk,nbasin), z4d2(jpi,jpj,jpk,nbasin) ) 200 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 191 201 zsfc = e1t(ji,jj) * e3t(ji,jj,jk,Kmm) 192 202 zmask(ji,jj,jk) = tmask(ji,jj,jk) * zsfc … … 195 205 END_3D 196 206 ! 197 DO jn = 1, n ptr207 DO jn = 1, nbasin 198 208 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 209 DO ji = 1, jpi 210 zmask(ji,:,:) = zmask(1,:,:) 211 ENDDO 199 212 z4d1(:,:,:,jn) = zmask(:,:,:) 200 213 ENDDO 201 214 CALL iom_put( 'zosrf', z4d1 ) 202 215 ! 203 DO jn = 1, n ptr216 DO jn = 1, nbasin 204 217 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 205 218 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) … … 210 223 CALL iom_put( 'zotem', z4d2 ) 211 224 ! 212 DO jn = 1, n ptr225 DO jn = 1, nbasin 213 226 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 214 227 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) … … 218 231 ENDDO 219 232 CALL iom_put( 'zosal', z4d2 ) 233 DEALLOCATE( z4d1, z4d2 ) 220 234 ! 221 235 ENDIF … … 224 238 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 225 239 ! 226 DO jn = 1, n ptr240 DO jn = 1, nbasin 227 241 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 228 242 DO ji = 1, jpi … … 231 245 ENDDO 232 246 CALL iom_put( 'sophtadv', z3dtr ) 233 DO jn = 1, n ptr247 DO jn = 1, nbasin 234 248 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 235 249 DO ji = 1, jpi … … 242 256 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 243 257 ! 244 DO jn = 1, n ptr258 DO jn = 1, nbasin 245 259 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 246 260 DO ji = 1, jpi … … 249 263 ENDDO 250 264 CALL iom_put( 'sophtldf', z3dtr ) 251 DO jn = 1, n ptr265 DO jn = 1, nbasin 252 266 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 253 267 DO ji = 1, jpi … … 260 274 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 261 275 ! 262 DO jn = 1, n ptr276 DO jn = 1, nbasin 263 277 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 264 278 DO ji = 1, jpi … … 267 281 ENDDO 268 282 CALL iom_put( 'sophteiv', z3dtr ) 269 DO jn = 1, n ptr283 DO jn = 1, nbasin 270 284 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 271 285 DO ji = 1, jpi … … 278 292 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 279 293 zts(:,:,:,:) = 0._wp 280 DO_3D _10_11(1, jpkm1 )294 DO_3D( 1, 0, 1, 1, 1, jpkm1 ) 281 295 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 282 296 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 … … 285 299 CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 286 300 CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 287 DO jn = 1, n ptr301 DO jn = 1, nbasin 288 302 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 289 303 DO ji = 1, jpi … … 292 306 ENDDO 293 307 CALL iom_put( 'sophtvtr', z3dtr ) 294 DO jn = 1, n ptr308 DO jn = 1, nbasin 295 309 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 296 310 DO ji = 1, jpi … … 309 323 ENDIF 310 324 ! 325 DEALLOCATE( z3dtr ) 326 ! 311 327 IF( ln_timing ) CALL timing_stop('dia_ptr') 312 328 ! … … 318 334 !! *** ROUTINE dia_ptr_init *** 319 335 !! 320 !! ** Purpose : Initialization , namelist read336 !! ** Purpose : Initialization 321 337 !!---------------------------------------------------------------------- 322 338 INTEGER :: inum, jn ! local integers … … 324 340 REAL(wp), DIMENSION(jpi,jpj) :: zmsk 325 341 !!---------------------------------------------------------------------- 326 327 l_diaptr = .FALSE. 328 IF( iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 329 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 330 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 331 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 332 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 333 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) ) l_diaptr = .TRUE. 334 342 343 ! l_diaptr is defined with iom_use 344 ! --> dia_ptr_init must be done after the call to iom_init 345 ! --> cannot be .TRUE. without cpp key: key_iom --> nbasin define by iom_init is initialized 346 l_diaptr = iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 347 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 348 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 349 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 350 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 351 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) 335 352 336 353 IF(lwp) THEN ! Control print … … 338 355 WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization' 339 356 WRITE(numout,*) '~~~~~~~~~~~~' 340 WRITE(numout,*) ' Namelist namptr : set ptr parameters'341 357 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) l_diaptr = ', l_diaptr 342 358 ENDIF … … 345 361 ! 346 362 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 347 363 ! 348 364 rc_pwatt = rc_pwatt * rho0_rcp ! conversion from K.s-1 to PetaWatt 349 365 rc_ggram = rc_ggram * rho0 ! conversion from m3/s to Gg/s … … 352 368 353 369 btmsk(:,:,1) = tmask_i(:,:) 354 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 355 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 356 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 357 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 358 CALL iom_close( inum ) 359 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 360 DO jn = 2, nptr 361 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 370 IF( nbasin == 5 ) THEN ! nbasin has been initialized in iom_init to define the axis "basin" 371 CALL iom_open( 'subbasins', inum ) 372 CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 373 CALL iom_get( inum, jpdom_global, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 374 CALL iom_get( inum, jpdom_global, 'indmsk', btmsk(:,:,4) ) ! Indian basin 375 CALL iom_close( inum ) 376 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 377 ENDIF 378 DO jn = 2, nbasin 379 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 362 380 END DO 363 381 ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations … … 368 386 END WHERE 369 387 btmsk34(:,:,1) = btmsk(:,:,1) 370 DO jn = 2, n ptr371 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only388 DO jn = 2, nbasin 389 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only 372 390 ENDDO 373 391 … … 403 421 IF( cptr == 'adv' ) THEN 404 422 IF( ktra == jp_tem ) THEN 405 DO jn = 1, n ptr423 DO jn = 1, nbasin 406 424 hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 407 425 ENDDO 408 426 ENDIF 409 427 IF( ktra == jp_sal ) THEN 410 DO jn = 1, n ptr428 DO jn = 1, nbasin 411 429 hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 412 430 ENDDO … … 416 434 IF( cptr == 'ldf' ) THEN 417 435 IF( ktra == jp_tem ) THEN 418 DO jn = 1, n ptr436 DO jn = 1, nbasin 419 437 hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 420 438 ENDDO 421 439 ENDIF 422 440 IF( ktra == jp_sal ) THEN 423 DO jn = 1, n ptr441 DO jn = 1, nbasin 424 442 hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 425 443 ENDDO … … 429 447 IF( cptr == 'eiv' ) THEN 430 448 IF( ktra == jp_tem ) THEN 431 DO jn = 1, n ptr449 DO jn = 1, nbasin 432 450 hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 433 451 ENDDO 434 452 ENDIF 435 453 IF( ktra == jp_sal ) THEN 436 DO jn = 1, n ptr454 DO jn = 1, nbasin 437 455 hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 438 456 ENDDO … … 442 460 IF( cptr == 'vtr' ) THEN 443 461 IF( ktra == jp_tem ) THEN 444 DO jn = 1, n ptr462 DO jn = 1, nbasin 445 463 hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 446 464 ENDDO 447 465 ENDIF 448 466 IF( ktra == jp_sal ) THEN 449 DO jn = 1, n ptr467 DO jn = 1, nbasin 450 468 hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 451 469 ENDDO … … 465 483 ierr(:) = 0 466 484 ! 485 ! nbasin has been initialized in iom_init to define the axis "basin" 486 ! 467 487 IF( .NOT. ALLOCATED( btmsk ) ) THEN 468 ALLOCATE( btmsk(jpi,jpj,n ptr) , btmsk34(jpi,jpj,nptr), &469 & hstr_adv(jpj,jpts,n ptr), hstr_eiv(jpj,jpts,nptr), &470 & hstr_ove(jpj,jpts,n ptr), hstr_btr(jpj,jpts,nptr), &471 & hstr_ldf(jpj,jpts,n ptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1) )488 ALLOCATE( btmsk(jpi,jpj,nbasin) , btmsk34(jpi,jpj,nbasin), & 489 & hstr_adv(jpj,jpts,nbasin), hstr_eiv(jpj,jpts,nbasin), & 490 & hstr_ove(jpj,jpts,nbasin), hstr_btr(jpj,jpts,nbasin), & 491 & hstr_ldf(jpj,jpts,nbasin), hstr_vtr(jpj,jpts,nbasin), STAT=ierr(1) ) 472 492 ! 473 493 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) … … 503 523 ijpj = jpj 504 524 p_fval(:) = 0._wp 505 DO_3D _00_00(1, jpkm1 )525 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 506 526 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 507 527 END_3D … … 536 556 ijpj = jpj 537 557 p_fval(:) = 0._wp 538 DO_2D _00_00558 DO_2D( 0, 0, 0, 0 ) 539 559 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 540 560 END_2D … … 565 585 p_fval(:,:) = 0._wp 566 586 DO jc = 1, jpnj ! looping over all processors in j axis 567 DO_2D _00_00587 DO_2D( 0, 0, 0, 0 ) 568 588 p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 569 589 END_2D 570 CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. )590 CALL lbc_lnk( 'diaptr', p_fval, 'U', -1.0_wp ) 571 591 END DO 572 592 ! … … 604 624 p_fval(:,:) = 0._wp 605 625 ! 606 DO_3D _00_00(1, jpkm1 )626 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 607 627 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 608 628 END_3D -
NEMO/branches/2020/dev_r12702_ASINTER-02_emanuelaclementi_Waves/src/OCE/DIA/diawri.F90
r12649 r13710 85 85 !! * Substitutions 86 86 # include "do_loop_substitute.h90" 87 # include "domzgr_substitute.h90" 87 88 !!---------------------------------------------------------------------- 88 89 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 117 118 INTEGER :: ji, jj, jk ! dummy loop indices 118 119 INTEGER :: ikbot ! local integer 120 REAL(wp):: ze3 119 121 REAL(wp):: zztmp , zztmpx ! local scalar 120 122 REAL(wp):: zztmp2, zztmpy ! - - … … 136 138 CALL iom_put("e3v_0", e3v_0(:,:,:) ) 137 139 ! 138 CALL iom_put( "e3t" , e3t(:,:,:,Kmm) ) 139 CALL iom_put( "e3u" , e3u(:,:,:,Kmm) ) 140 CALL iom_put( "e3v" , e3v(:,:,:,Kmm) ) 141 CALL iom_put( "e3w" , e3w(:,:,:,Kmm) ) 142 IF( iom_use("e3tdef") ) & 143 CALL iom_put( "e3tdef" , ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 144 145 IF( ll_wd ) THEN 146 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) ! sea surface height (brought back to the reference used for wetting and drying) 140 IF ( iom_use("e3t") .OR. iom_use("e3tdef") ) THEN ! time-varying e3t 141 DO jk = 1, jpk 142 z3d(:,:,jk) = e3t(:,:,jk,Kmm) 143 END DO 144 CALL iom_put( "e3t" , z3d(:,:,:) ) 145 CALL iom_put( "e3tdef" , ( ( z3d(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 ) 146 ENDIF 147 IF ( iom_use("e3u") ) THEN ! time-varying e3u 148 DO jk = 1, jpk 149 z3d(:,:,jk) = e3u(:,:,jk,Kmm) 150 END DO 151 CALL iom_put( "e3u" , z3d(:,:,:) ) 152 ENDIF 153 IF ( iom_use("e3v") ) THEN ! time-varying e3v 154 DO jk = 1, jpk 155 z3d(:,:,jk) = e3v(:,:,jk,Kmm) 156 END DO 157 CALL iom_put( "e3v" , z3d(:,:,:) ) 158 ENDIF 159 IF ( iom_use("e3w") ) THEN ! time-varying e3w 160 DO jk = 1, jpk 161 z3d(:,:,jk) = e3w(:,:,jk,Kmm) 162 END DO 163 CALL iom_put( "e3w" , z3d(:,:,:) ) 164 ENDIF 165 166 IF( ll_wd ) THEN ! sea surface height (brought back to the reference used for wetting and drying) 167 CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) ) 147 168 ELSE 148 169 CALL iom_put( "ssh" , ssh(:,:,Kmm) ) ! sea surface height … … 155 176 CALL iom_put( "sst", ts(:,:,1,jp_tem,Kmm) ) ! surface temperature 156 177 IF ( iom_use("sbt") ) THEN 157 DO_2D _11_11178 DO_2D( 0, 0, 0, 0 ) 158 179 ikbot = mbkt(ji,jj) 159 180 z2d(ji,jj) = ts(ji,jj,ikbot,jp_tem,Kmm) … … 165 186 CALL iom_put( "sss", ts(:,:,1,jp_sal,Kmm) ) ! surface salinity 166 187 IF ( iom_use("sbs") ) THEN 167 DO_2D _11_11188 DO_2D( 0, 0, 0, 0 ) 168 189 ikbot = mbkt(ji,jj) 169 190 z2d(ji,jj) = ts(ji,jj,ikbot,jp_sal,Kmm) … … 172 193 ENDIF 173 194 195 #if ! defined key_qco 196 CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0) 197 #endif 198 174 199 IF ( iom_use("taubot") ) THEN ! bottom stress 175 200 zztmp = rho0 * 0.25 176 201 z2d(:,:) = 0._wp 177 DO_2D _00_00202 DO_2D( 0, 0, 0, 0 ) 178 203 zztmp2 = ( ( rCdU_bot(ji+1,jj)+rCdU_bot(ji ,jj) ) * uu(ji ,jj,mbku(ji ,jj),Kmm) )**2 & 179 204 & + ( ( rCdU_bot(ji ,jj)+rCdU_bot(ji-1,jj) ) * uu(ji-1,jj,mbku(ji-1,jj),Kmm) )**2 & … … 183 208 ! 184 209 END_2D 185 CALL lbc_lnk( 'diawri', z2d, 'T', 1. )186 210 CALL iom_put( "taubot", z2d ) 187 211 ENDIF … … 190 214 CALL iom_put( "ssu", uu(:,:,1,Kmm) ) ! surface i-current 191 215 IF ( iom_use("sbu") ) THEN 192 DO_2D _11_11216 DO_2D( 0, 0, 0, 0 ) 193 217 ikbot = mbku(ji,jj) 194 218 z2d(ji,jj) = uu(ji,jj,ikbot,Kmm) … … 200 224 CALL iom_put( "ssv", vv(:,:,1,Kmm) ) ! surface j-current 201 225 IF ( iom_use("sbv") ) THEN 202 DO_2D _11_11226 DO_2D( 0, 0, 0, 0 ) 203 227 ikbot = mbkv(ji,jj) 204 228 z2d(ji,jj) = vv(ji,jj,ikbot,Kmm) … … 208 232 209 233 IF( ln_zad_Aimp ) ww = ww + wi ! Recombine explicit and implicit parts of vertical velocity for diagnostic output 210 !211 234 CALL iom_put( "woce", ww ) ! vertical velocity 235 212 236 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 213 237 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. … … 229 253 IF( iom_use('logavs') ) CALL iom_put( "logavs", LOG( MAX( 1.e-20_wp, avs(:,:,:) ) ) ) 230 254 255 IF ( iom_use("socegrad") .OR. iom_use("socegrad2") ) THEN 256 z3d(:,:,jpk) = 0. 257 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 258 zztmp = ts(ji,jj,jk,jp_sal,Kmm) 259 zztmpx = (ts(ji+1,jj,jk,jp_sal,Kmm) - zztmp) * r1_e1u(ji,jj) + (zztmp - ts(ji-1,jj ,jk,jp_sal,Kmm)) * r1_e1u(ji-1,jj) 260 zztmpy = (ts(ji,jj+1,jk,jp_sal,Kmm) - zztmp) * r1_e2v(ji,jj) + (zztmp - ts(ji ,jj-1,jk,jp_sal,Kmm)) * r1_e2v(ji,jj-1) 261 z3d(ji,jj,jk) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 262 & * umask(ji,jj,jk) * umask(ji-1,jj,jk) * vmask(ji,jj,jk) * umask(ji,jj-1,jk) 263 END_3D 264 CALL iom_put( "socegrad2", z3d ) ! square of module of sal gradient 265 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 266 z3d(ji,jj,jk) = SQRT( z3d(ji,jj,jk) ) 267 END_3D 268 CALL iom_put( "socegrad" , z3d ) ! module of sal gradient 269 ENDIF 270 231 271 IF ( iom_use("sstgrad") .OR. iom_use("sstgrad2") ) THEN 232 DO_2D _00_00272 DO_2D( 0, 0, 0, 0 ) ! sst gradient 233 273 zztmp = ts(ji,jj,1,jp_tem,Kmm) 234 274 zztmpx = ( ts(ji+1,jj,1,jp_tem,Kmm) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - ts(ji-1,jj ,1,jp_tem,Kmm) ) * r1_e1u(ji-1,jj) … … 237 277 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 238 278 END_2D 239 CALL lbc_lnk( 'diawri', z2d, 'T', 1. )240 279 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 241 z2d(:,:) = SQRT( z2d(:,:) ) 280 DO_2D( 0, 0, 0, 0 ) 281 z2d(ji,jj) = SQRT( z2d(ji,jj) ) 282 END_2D 242 283 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 243 284 ENDIF … … 246 287 IF( iom_use("heatc") ) THEN 247 288 z2d(:,:) = 0._wp 248 DO_3D _11_11(1, jpkm1 )289 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 249 290 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) * tmask(ji,jj,jk) 250 291 END_3D … … 254 295 IF( iom_use("saltc") ) THEN 255 296 z2d(:,:) = 0._wp 256 DO_3D _11_11(1, jpkm1 )297 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 257 298 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 258 299 END_3D … … 260 301 ENDIF 261 302 ! 262 IF ( iom_use("eken") ) THEN 303 IF( iom_use("salt2c") ) THEN 304 z2d(:,:) = 0._wp 305 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 306 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) * tmask(ji,jj,jk) 307 END_3D 308 CALL iom_put( "salt2c", rho0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 309 ENDIF 310 ! 311 IF ( iom_use("ke") .OR. iom_use("ke_int") ) THEN 263 312 z3d(:,:,jpk) = 0._wp 264 DO_3D_00_00( 1, jpkm1 ) 265 zztmp = 0.25_wp * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 266 z3d(ji,jj,jk) = zztmp * ( uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 267 & + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 268 & + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 269 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 270 END_3D 271 CALL lbc_lnk( 'diawri', z3d, 'T', 1. ) 272 CALL iom_put( "eken", z3d ) ! kinetic energy 313 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 314 zztmpx = 0.5 * ( uu(ji-1,jj ,jk,Kmm) + uu(ji,jj,jk,Kmm) ) 315 zztmpy = 0.5 * ( vv(ji ,jj-1,jk,Kmm) + vv(ji,jj,jk,Kmm) ) 316 z3d(ji,jj,jk) = 0.5 * ( zztmpx*zztmpx + zztmpy*zztmpy ) 317 END_3D 318 CALL iom_put( "ke", z3d ) ! kinetic energy 319 320 z2d(:,:) = 0._wp 321 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 322 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * e1e2t(ji,jj) * tmask(ji,jj,jk) 323 END_3D 324 CALL iom_put( "ke_int", z2d ) ! vertically integrated kinetic energy 273 325 ENDIF 274 326 ! 275 327 CALL iom_put( "hdiv", hdiv ) ! Horizontal divergence 328 329 IF ( iom_use("relvor") .OR. iom_use("absvor") .OR. iom_use("potvor") ) THEN 330 331 z3d(:,:,jpk) = 0._wp 332 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 333 z3d(ji,jj,jk) = ( e2v(ji+1,jj ) * vv(ji+1,jj ,jk,Kmm) - e2v(ji,jj) * vv(ji,jj,jk,Kmm) & 334 & - e1u(ji ,jj+1) * uu(ji ,jj+1,jk,Kmm) + e1u(ji,jj) * uu(ji,jj,jk,Kmm) ) * r1_e1e2f(ji,jj) 335 END_3D 336 CALL iom_put( "relvor", z3d ) ! relative vorticity 337 338 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 339 z3d(ji,jj,jk) = ff_f(ji,jj) + z3d(ji,jj,jk) 340 END_3D 341 CALL iom_put( "absvor", z3d ) ! absolute vorticity 342 343 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 344 ze3 = ( e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 345 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 346 IF( ze3 /= 0._wp ) THEN ; ze3 = 4._wp / ze3 347 ELSE ; ze3 = 0._wp 348 ENDIF 349 z3d(ji,jj,jk) = ze3 * z3d(ji,jj,jk) 350 END_3D 351 CALL iom_put( "potvor", z3d ) ! potential vorticity 352 353 ENDIF 276 354 ! 277 355 IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN … … 288 366 IF( iom_use("u_heattr") ) THEN 289 367 z2d(:,:) = 0._wp 290 DO_3D _00_00(1, jpkm1 )368 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 291 369 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 292 370 END_3D 293 CALL lbc_lnk( 'diawri', z2d, 'U', -1. )294 371 CALL iom_put( "u_heattr", 0.5*rcp * z2d ) ! heat transport in i-direction 295 372 ENDIF … … 297 374 IF( iom_use("u_salttr") ) THEN 298 375 z2d(:,:) = 0.e0 299 DO_3D _00_00(1, jpkm1 )376 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 300 377 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 301 378 END_3D 302 CALL lbc_lnk( 'diawri', z2d, 'U', -1. )303 379 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 304 380 ENDIF … … 315 391 IF( iom_use("v_heattr") ) THEN 316 392 z2d(:,:) = 0.e0 317 DO_3D _00_00(1, jpkm1 )393 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 318 394 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 319 395 END_3D 320 CALL lbc_lnk( 'diawri', z2d, 'V', -1. )321 396 CALL iom_put( "v_heattr", 0.5*rcp * z2d ) ! heat transport in j-direction 322 397 ENDIF … … 324 399 IF( iom_use("v_salttr") ) THEN 325 400 z2d(:,:) = 0._wp 326 DO_3D _00_00(1, jpkm1 )401 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 327 402 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 328 403 END_3D 329 CALL lbc_lnk( 'diawri', z2d, 'V', -1. )330 404 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 331 405 ENDIF … … 333 407 IF( iom_use("tosmint") ) THEN 334 408 z2d(:,:) = 0._wp 335 DO_3D _00_00(1, jpkm1 )409 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 336 410 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) 337 411 END_3D 338 CALL lbc_lnk( 'diawri', z2d, 'T', -1. )339 412 CALL iom_put( "tosmint", rho0 * z2d ) ! Vertical integral of temperature 340 413 ENDIF 341 414 IF( iom_use("somint") ) THEN 342 415 z2d(:,:)=0._wp 343 DO_3D _00_00(1, jpkm1 )416 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 344 417 z2d(ji,jj) = z2d(ji,jj) + e3t(ji,jj,jk,Kmm) * ts(ji,jj,jk,jp_sal,Kmm) 345 418 END_3D 346 CALL lbc_lnk( 'diawri', z2d, 'T', -1. )347 419 CALL iom_put( "somint", rho0 * z2d ) ! Vertical integral of salinity 348 420 ENDIF … … 415 487 ! 416 488 REAL(wp), DIMENSION(jpi,jpj) :: zw2d ! 2D workspace 417 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d ! 3D workspace489 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zw3d, ze3t, zgdept ! 3D workspace 418 490 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zw3d_abl ! ABL 3D workspace 419 491 !!---------------------------------------------------------------------- … … 447 519 448 520 ! Define indices of the horizontal output zoom and vertical limit storage 449 iimi = 1 ; iima = jpi450 ijmi = 1 ; ijma = jpj521 iimi = Nis0 ; iima = Nie0 522 ijmi = Njs0 ; ijma = Nje0 451 523 ipk = jpk 452 524 IF(ln_abl) ipka = jpkam1 … … 455 527 it = kt 456 528 itmod = kt - nit000 + 1 529 530 ! store e3t for subsitute 531 DO jk = 1, jpk 532 ze3t (:,:,jk) = e3t (:,:,jk,Kmm) 533 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 534 END DO 457 535 458 536 … … 569 647 DEALLOCATE(zw3d_abl) 570 648 ENDIF 649 ! 571 650 572 651 ! Declare all the output fields as NETCDF variables … … 578 657 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 579 658 IF( .NOT.ln_linssh ) THEN 580 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t (:,:,:,Kmm)659 CALL histdef( nid_T, "vovvle3t", "Level thickness" , "m" ,& ! e3t n 581 660 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 582 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t (:,:,:,Kmm)661 CALL histdef( nid_T, "vovvldep", "T point depth" , "m" ,& ! e3t n 583 662 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 584 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t (:,:,:,Kmm)663 CALL histdef( nid_T, "vovvldef", "Squared level deformation" , "%^2" ,& ! e3t n 585 664 & jpi, jpj, nh_T, ipk, 1, ipk, nz_T, 32, clop, zsto, zout ) 586 665 ENDIF … … 766 845 767 846 IF( .NOT.ln_linssh ) THEN 768 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! heat content769 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * e3t(:,:,:,Kmm) , ndim_T , ndex_T ) ! salt content770 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface heat content771 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * e3t(:,:,1,Kmm) , ndim_hT, ndex_hT ) ! sea surface salinity content847 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! heat content 848 CALL histwrite( nid_T, "vosaline", it, ts(:,:,:,jp_sal,Kmm) * ze3t(:,:,:) , ndim_T , ndex_T ) ! salt content 849 CALL histwrite( nid_T, "sosstsst", it, ts(:,:,1,jp_tem,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface heat content 850 CALL histwrite( nid_T, "sosaline", it, ts(:,:,1,jp_sal,Kmm) * ze3t(:,:,1) , ndim_hT, ndex_hT ) ! sea surface salinity content 772 851 ELSE 773 852 CALL histwrite( nid_T, "votemper", it, ts(:,:,:,jp_tem,Kmm) , ndim_T , ndex_T ) ! temperature … … 777 856 ENDIF 778 857 IF( .NOT.ln_linssh ) THEN 779 zw3d(:,:,:) = ( ( e3t(:,:,:,Kmm) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2780 CALL histwrite( nid_T, "vovvle3t", it, e3t (:,:,:,Kmm), ndim_T , ndex_T ) ! level thickness781 CALL histwrite( nid_T, "vovvldep", it, gdept(:,:,:,Kmm) , ndim_T , ndex_T ) ! t-point depth858 zw3d(:,:,:) = ( ( ze3t(:,:,:) - e3t_0(:,:,:) ) / e3t_0(:,:,:) * 100 * tmask(:,:,:) ) ** 2 859 CALL histwrite( nid_T, "vovvle3t", it, ze3t (:,:,:) , ndim_T , ndex_T ) ! level thickness 860 CALL histwrite( nid_T, "vovvldep", it, zgdept , ndim_T , ndex_T ) ! t-point depth 782 861 CALL histwrite( nid_T, "vovvldef", it, zw3d , ndim_T , ndex_T ) ! level thickness deformation 783 862 ENDIF … … 918 997 !! 919 998 INTEGER :: inum, jk 999 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, zgdept ! 3D workspace !!st patch to use substitution 920 1000 !!---------------------------------------------------------------------- 921 1001 ! 922 IF(lwp) WRITE(numout,*) 923 IF(lwp) WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 924 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 925 IF(lwp) WRITE(numout,*) ' and named :', cdfile_name, '...nc' 1002 IF(lwp) THEN 1003 WRITE(numout,*) 1004 WRITE(numout,*) 'dia_wri_state : single instantaneous ocean state' 1005 WRITE(numout,*) '~~~~~~~~~~~~~ and forcing fields file created ' 1006 WRITE(numout,*) ' and named :', cdfile_name, '...nc' 1007 ENDIF 1008 ! 1009 DO jk = 1, jpk 1010 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 1011 zgdept(:,:,jk) = gdept(:,:,jk,Kmm) 1012 END DO 926 1013 ! 927 1014 CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE. ) … … 938 1025 ENDIF 939 1026 CALL iom_rstput( 0, 0, inum, 'risfdep', risfdep ) ! now k-velocity 940 CALL iom_rstput( 0, 0, inum, 'ht' , ht 1027 CALL iom_rstput( 0, 0, inum, 'ht' , ht(:,:) ) ! now water column height 941 1028 ! 942 1029 IF ( ln_isf ) THEN … … 975 1062 CALL iom_rstput( 0, 0, inum, 'sometauy', vtau ) ! j-wind stress 976 1063 IF( .NOT.ln_linssh ) THEN 977 CALL iom_rstput( 0, 0, inum, 'vovvldep', gdept(:,:,:,Kmm)) ! T-cell depth978 CALL iom_rstput( 0, 0, inum, 'vovvle3t', e3t(:,:,:,Kmm)) ! T-cell thickness1064 CALL iom_rstput( 0, 0, inum, 'vovvldep', zgdept ) ! T-cell depth 1065 CALL iom_rstput( 0, 0, inum, 'vovvle3t', ze3t ) ! T-cell thickness 979 1066 END IF 980 1067 IF( ln_wave .AND. ln_sdw ) THEN … … 998 1085 CALL iom_close( inum ) 999 1086 ENDIF 1087 ! 1000 1088 #endif 1001 1002 1089 END SUBROUTINE dia_wri_state 1003 1090
Note: See TracChangeset
for help on using the changeset viewer.
