Changeset 12377 for NEMO/trunk/src/OCE/CRS/crsfld.F90
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/CRS/crsfld.F90
r10425 r12377 32 32 33 33 !! * Substitutions 34 # include " vectopt_loop_substitute.h90"34 # include "do_loop_substitute.h90" 35 35 !!---------------------------------------------------------------------- 36 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 40 40 CONTAINS 41 41 42 SUBROUTINE crs_fld( kt )42 SUBROUTINE crs_fld( kt, Kmm ) 43 43 !!--------------------------------------------------------------------- 44 44 !! *** ROUTINE crs_fld *** … … 54 54 !!---------------------------------------------------------------------- 55 55 INTEGER, INTENT(in) :: kt ! ocean time-step index 56 INTEGER, INTENT(in) :: Kmm ! time level index 56 57 ! 57 58 INTEGER :: ji, jj, jk ! dummy loop indices … … 67 68 68 69 ! Depth work arrrays 69 ze3t(:,:,:) = e3t _n(:,:,:)70 ze3u(:,:,:) = e3u _n(:,:,:)71 ze3v(:,:,:) = e3v _n(:,:,:)72 ze3w(:,:,:) = e3w _n(:,:,:)70 ze3t(:,:,:) = e3t(:,:,:,Kmm) 71 ze3u(:,:,:) = e3u(:,:,:,Kmm) 72 ze3v(:,:,:) = e3v(:,:,:,Kmm) 73 ze3w(:,:,:) = e3w(:,:,:,Kmm) 73 74 74 75 IF( kt == nit000 ) THEN … … 96 97 97 98 ! Temperature 98 zt(:,:,:) = ts n(:,:,:,jp_tem) ; zt_crs(:,:,:) = 0._wp99 zt(:,:,:) = ts(:,:,:,jp_tem,Kmm) ; zt_crs(:,:,:) = 0._wp 99 100 CALL crs_dom_ope( zt, 'VOL', 'T', tmask, zt_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 100 101 tsn_crs(:,:,:,jp_tem) = zt_crs(:,:,:) … … 105 106 106 107 ! Salinity 107 zs(:,:,:) = ts n(:,:,:,jp_sal) ; zs_crs(:,:,:) = 0._wp108 zs(:,:,:) = ts(:,:,:,jp_sal,Kmm) ; zs_crs(:,:,:) = 0._wp 108 109 CALL crs_dom_ope( zs, 'VOL', 'T', tmask, zs_crs, p_e12=e1e2t, p_e3=ze3t, psgn=1.0 ) 109 110 tsn_crs(:,:,:,jp_sal) = zt_crs(:,:,:) … … 113 114 114 115 ! U-velocity 115 CALL crs_dom_ope( u n, 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 )116 CALL crs_dom_ope( uu(:,:,:,Kmm), 'SUM', 'U', umask, un_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 116 117 ! 117 118 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 118 DO jk = 1, jpkm1 119 DO jj = 2, jpjm1 120 DO ji = 2, jpim1 121 zt(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 122 zs(ji,jj,jk) = un(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 123 END DO 124 END DO 125 END DO 119 DO_3D_00_00( 1, jpkm1 ) 120 zt(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji+1,jj,jk,jp_tem,Kmm) ) 121 zs(ji,jj,jk) = uu(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji+1,jj,jk,jp_sal,Kmm) ) 122 END_3D 126 123 CALL crs_dom_ope( zt, 'SUM', 'U', umask, zt_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) 127 124 CALL crs_dom_ope( zs, 'SUM', 'U', umask, zs_crs, p_e12=e2u, p_e3=ze3u, p_surf_crs=e2e3u_msk, psgn=-1.0 ) … … 132 129 133 130 ! V-velocity 134 CALL crs_dom_ope( v n, 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 )131 CALL crs_dom_ope( vv(:,:,:,Kmm), 'SUM', 'V', vmask, vn_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 135 132 ! 136 133 zt(:,:,:) = 0._wp ; zs(:,:,:) = 0._wp ; zt_crs(:,:,:) = 0._wp ; zs_crs(:,:,:) = 0._wp 137 DO jk = 1, jpkm1 138 DO jj = 2, jpjm1 139 DO ji = 2, jpim1 140 zt(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 141 zs(ji,jj,jk) = vn(ji,jj,jk) * 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 142 END DO 143 END DO 144 END DO 134 DO_3D_00_00( 1, jpkm1 ) 135 zt(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_tem,Kmm) + ts(ji,jj+1,jk,jp_tem,Kmm) ) 136 zs(ji,jj,jk) = vv(ji,jj,jk,Kmm) * 0.5 * ( ts(ji,jj,jk,jp_sal,Kmm) + ts(ji,jj+1,jk,jp_sal,Kmm) ) 137 END_3D 145 138 CALL crs_dom_ope( zt, 'SUM', 'V', vmask, zt_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) 146 139 CALL crs_dom_ope( zs, 'SUM', 'V', vmask, zs_crs, p_e12=e1v, p_e3=ze3v, p_surf_crs=e1e3v_msk, psgn=-1.0 ) … … 152 145 IF( iom_use( "eken") ) THEN ! kinetic energy 153 146 z3d(:,:,jk) = 0._wp 154 DO jk = 1, jpkm1 155 DO jj = 2, jpjm1 156 DO ji = fs_2, fs_jpim1 ! vector opt. 157 zztmp = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 158 z3d(ji,jj,jk) = 0.25_wp * zztmp * ( & 159 & un(ji-1,jj,jk)**2 * e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) & 160 & + un(ji ,jj,jk)**2 * e2u(ji ,jj) * e3u_n(ji ,jj,jk) & 161 & + vn(ji,jj-1,jk)**2 * e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) & 162 & + vn(ji,jj ,jk)**2 * e1v(ji,jj ) * e3v_n(ji,jj ,jk) ) 163 END DO 164 END DO 165 END DO 147 DO_3D_00_00( 1, jpkm1 ) 148 zztmp = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 149 z3d(ji,jj,jk) = 0.25_wp * zztmp * ( & 150 & uu(ji-1,jj,jk,Kmm)**2 * e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 151 & + uu(ji ,jj,jk,Kmm)**2 * e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 152 & + vv(ji,jj-1,jk,Kmm)**2 * e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 153 & + vv(ji,jj ,jk,Kmm)**2 * e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) ) 154 END_3D 166 155 CALL lbc_lnk( 'crsfld', z3d, 'T', 1. ) 167 156 ! … … 191 180 ! W-velocity 192 181 IF( ln_crs_wn ) THEN 193 CALL crs_dom_ope( w n, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 )194 ! CALL crs_dom_ope( w n, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w )182 CALL crs_dom_ope( ww, 'SUM', 'W', tmask, wn_crs, p_e12=e1e2t, p_surf_crs=e1e2w_msk, psgn=1.0 ) 183 ! CALL crs_dom_ope( ww, 'VOL', 'W', tmask, wn_crs, p_e12=e1e2t, p_e3=ze3w ) 195 184 ELSE 196 185 wn_crs(:,:,jpk) = 0._wp … … 219 208 220 209 ! sbc fields 221 CALL crs_dom_ope( ssh n, 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0 )210 CALL crs_dom_ope( ssh(:,:,Kmm) , 'VOL', 'T', tmask, sshn_crs , p_e12=e1e2t, p_e3=ze3t , psgn=1.0 ) 222 211 CALL crs_dom_ope( utau , 'SUM', 'U', umask, utau_crs , p_e12=e2u , p_surf_crs=e2u_crs , psgn=1.0 ) 223 212 CALL crs_dom_ope( vtau , 'SUM', 'V', vmask, vtau_crs , p_e12=e1v , p_surf_crs=e1v_crs , psgn=1.0 )
Note: See TracChangeset
for help on using the changeset viewer.