Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90 (modified) (5 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
- Property svn:eol-style deleted
r1892 r2528 4 4 !! Ocean active tracers: surface boundary condition 5 5 !!============================================================================== 6 !! History : 8.2 ! 98-10 (G. Madec, G. Roullet, M. Imbard) Original code 7 !! 8.2 ! 01-02 (D. Ludicone) sea ice and free surface 8 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 6 !! History : OPA ! 1998-10 (G. Madec, G. Roullet, M. Imbard) Original code 7 !! 8.2 ! 2001-02 (D. Ludicone) sea ice and free surface 8 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) Forcing averaged over 2 time steps 10 !! - ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 9 11 !!---------------------------------------------------------------------- 10 12 … … 17 19 USE phycst ! physical constant 18 20 USE traqsr ! solar radiation penetration 19 USE trdmod 20 USE trd mod_oce ! ocean variablestrends21 USE trdmod_oce ! ocean trends 22 USE trdtra ! ocean trends 21 23 USE in_out_manager ! I/O manager 22 24 USE prtctl ! Print control 25 USE restart ! ocean restart 26 USE sbcrnf ! River runoff 27 USE sbcmod ! ln_rnf 28 USE iom 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 30 24 31 IMPLICIT NONE … … 31 38 # include "vectopt_loop_substitute.h90" 32 39 !!---------------------------------------------------------------------- 33 !! OPA 9.0 , LOCEAN-IPSL (2005)40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 34 41 !! $Id$ 35 !! Software governed by the CeCILL licence ( modipsl/doc/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 43 !!---------------------------------------------------------------------- 37 44 … … 98 105 !! - save the trend it in ttrd ('key_trdtra') 99 106 !!---------------------------------------------------------------------- 100 USE oce, ONLY : ztrdt => ua ! use ua as 3D workspace 101 USE oce, ONLY : ztrds => va ! use va as 3D workspace 102 !! 103 INTEGER, INTENT(in) :: kt ! ocean time-step index 104 !! 105 INTEGER :: ji, jj ! dummy loop indices 106 REAL(wp) :: zta, zsa, zsrau, zse3t ! temporary scalars 107 INTEGER, INTENT(in) :: kt ! ocean time-step index 108 !! 109 INTEGER :: ji, jj, jk, jn ! dummy loop indices 110 REAL(wp) :: zfact, z1_e3t, zsrau, zdep 111 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 107 112 !!---------------------------------------------------------------------- 108 113 … … 114 119 115 120 zsrau = 1. / rau0 ! initialization 116 #if defined key_zco 117 zse3t = 1. / e3t_0(1) 118 #endif 119 120 IF( l_trdtra ) THEN ! Save ta and sa trends 121 ztrdt(:,:,:) = ta(:,:,:) 122 ztrds(:,:,:) = sa(:,:,:) 123 ENDIF 124 125 IF( .NOT.ln_traqsr ) qsr(:,:) = 0.e0 ! no solar radiation penetration 126 127 ! Concentration dillution effect on (t,s) 128 DO jj = 2, jpj 129 DO ji = fs_2, fs_jpim1 ! vector opt. 130 #if ! defined key_zco 131 zse3t = 1. / fse3t(ji,jj,1) 132 #endif 133 IF( lk_vvl) THEN 134 zta = ro0cpr * qns(ji,jj) * zse3t & ! temperature : heat flux 135 & - emp(ji,jj) * zsrau * tn(ji,jj,1) * zse3t ! & cooling/heating effet of EMP flux 136 zsa = ( emps(ji,jj) - emp(ji,jj) ) & 137 & * zsrau * sn(ji,jj,1) * zse3t ! concent./dilut. effect due to sea-ice 138 ! melt/formation and (possibly) SSS restoration 139 ELSE 140 zta = ro0cpr * qns(ji,jj) * zse3t ! temperature : heat flux 141 zsa = emps(ji,jj) * zsrau * sn(ji,jj,1) * zse3t ! salinity : concent./dilut. effect 142 ENDIF 143 ta(ji,jj,1) = ta(ji,jj,1) + zta ! add the trend to the general tracer trend 144 sa(ji,jj,1) = sa(ji,jj,1) + zsa 121 122 IF( l_trdtra ) THEN !* Save ta and sa trends 123 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 124 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = tsa(:,:,:,jp_sal) 125 ENDIF 126 127 !!gm IF( .NOT.ln_traqsr ) qsr(:,:) = 0.e0 ! no solar radiation penetration 128 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 129 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 130 qsr(:,:) = 0.e0 ! qsr set to zero 131 ENDIF 132 133 !---------------------------------------- 134 ! EMP, EMPS and QNS effects 135 !---------------------------------------- 136 ! Set before sbc tracer content fields 137 ! ************************************ 138 IF( kt == nit000 ) THEN ! Set the forcing field at nit000 - 1 139 ! ! ----------------------------------- 140 IF( ln_rstart .AND. & ! Restart: read in restart file 141 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 142 IF(lwp) WRITE(numout,*) ' nit000-1 surface tracer content forcing fields red in the restart file' 143 zfact = 0.5e0 144 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 145 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 146 ELSE ! No restart or restart not found: Euler forward time stepping 147 zfact = 1.e0 148 sbc_tsc_b(:,:,:) = 0.e0 149 ENDIF 150 ELSE ! Swap of forcing fields 151 ! ! ---------------------- 152 zfact = 0.5e0 153 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 154 ENDIF 155 ! Compute now sbc tracer content fields 156 ! ************************************* 157 158 ! Concentration dilution effect on (t,s) due to 159 ! evaporation, precipitation and qns, but not river runoff 160 161 IF( lk_vvl ) THEN ! Variable Volume case 162 DO jj = 2, jpj 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 ! temperature : heat flux + cooling/heating effet of EMP flux 165 sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) - zsrau * emp(ji,jj) * tsn(ji,jj,1,jp_tem) 166 ! concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration 167 sbc_tsc(ji,jj,jp_sal) = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) 168 END DO 169 END DO 170 ELSE ! Constant Volume case 171 DO jj = 2, jpj 172 DO ji = fs_2, fs_jpim1 ! vector opt. 173 ! temperature : heat flux 174 sbc_tsc(ji,jj,jp_tem) = ro0cpr * qns(ji,jj) 175 ! salinity : salt flux + concent./dilut. effect (both in emps) 176 sbc_tsc(ji,jj,jp_sal) = zsrau * emps(ji,jj) * tsn(ji,jj,1,jp_sal) 177 END DO 178 END DO 179 ENDIF 180 ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff 181 DO jn = 1, jpts 182 DO jj = 2, jpj 183 DO ji = fs_2, fs_jpim1 ! vector opt. 184 z1_e3t = zfact / fse3t(ji,jj,1) 185 tsa(ji,jj,1,jn) = tsa(ji,jj,1,jn) + ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) * z1_e3t 186 END DO 145 187 END DO 146 188 END DO 147 148 IF( l_trdtra ) THEN ! save the sbc trends for diagnostic 149 ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 150 ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 151 CALL trd_mod(ztrdt, ztrds, jptra_trd_nsr, 'TRA', kt) 152 ENDIF 153 ! 154 IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' sbc - Ta: ', mask1=tmask, & 155 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 189 ! Write in the ocean restart file 190 ! ******************************* 191 IF( lrst_oce ) THEN 192 IF(lwp) WRITE(numout,*) 193 IF(lwp) WRITE(numout,*) 'sbc : ocean surface tracer content forcing fields written in ocean restart file ', & 194 & 'at it= ', kt,' date= ', ndastp 195 IF(lwp) WRITE(numout,*) '~~~~' 196 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 197 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) ) 198 ENDIF 199 ! 200 !---------------------------------------- 201 ! River Runoff effects 202 !---------------------------------------- 203 ! 204 zfact = 0.5e0 205 206 ! Effect on (t,s) due to river runoff (dilution effect automatically applied via vertical tracer advection) 207 IF( ln_rnf ) THEN 208 DO jj = 2, jpj 209 DO ji = fs_2, fs_jpim1 210 zdep = 1. / h_rnf(ji,jj) 211 zdep = zfact * zdep 212 IF ( rnf(ji,jj) .ne. 0.0 ) THEN 213 DO jk = 1, nk_rnf(ji,jj) 214 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 215 & + ( rnf_tsc_b(ji,jj,jp_tem) + rnf_tsc(ji,jj,jp_tem) ) * zdep 216 IF( ln_rnf_sal ) tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 217 & + ( rnf_tsc_b(ji,jj,jp_sal) + rnf_tsc(ji,jj,jp_sal) ) * zdep 218 ENDDO 219 ENDIF 220 ENDDO 221 ENDDO 222 ENDIF 223 !!gm It should be useless 224 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 225 226 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 227 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 228 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 229 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_nsr, ztrdt ) 230 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_nsr, ztrds ) 231 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 232 ENDIF 233 ! 234 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' sbc - Ta: ', mask1=tmask, & 235 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 156 236 ! 157 237 END SUBROUTINE tra_sbc
Note: See TracChangeset
for help on using the changeset viewer.
