- Timestamp:
- 2019-08-16T12:32:43+02:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA
- Files:
-
- 4 edited
-
trabbc.F90 (modified) (5 diffs)
-
trabbl.F90 (modified) (6 diffs)
-
traldf.F90 (modified) (3 diffs)
-
traqsr.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r6486 r11442 28 28 USE wrk_nemo ! Memory Allocation 29 29 USE timing ! Timing 30 USE stopack 30 31 31 32 IMPLICIT NONE … … 41 42 42 43 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd0 ! geothermal heating trend 44 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd1 ! geothermal heating trend 43 45 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_qgh ! structure of input qgh (file informations, fields read) 44 46 … … 89 91 ! 90 92 ! ! Add the geothermal heat flux trend on temperature 93 94 IF( ln_stopack .AND. nn_spp_geot > 0) THEN 95 qgh_trd1(:,:) = qgh_trd0(:,:) 96 CALL spp_gen(kt, qgh_trd1, nn_spp_geot, rn_geot_sd, jk_spp_geot) 97 ENDIF 91 98 DO jj = 2, jpjm1 92 99 DO ji = 2, jpim1 93 100 ik = mbkt(ji,jj) 94 zqgh_trd = qgh_trd 0(ji,jj) / fse3t(ji,jj,ik)101 zqgh_trd = qgh_trd1(ji,jj) / fse3t(ji,jj,ik) 95 102 tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 96 103 END DO … … 163 170 ! 164 171 ALLOCATE( qgh_trd0(jpi,jpj) ) ! allocation 172 ALLOCATE( qgh_trd1(jpi,jpj) ) ! allocation 165 173 ! 166 174 SELECT CASE ( nn_geoflx ) ! geothermal heat flux / (rauO * Cp) … … 192 200 ! 193 201 END SELECT 202 qgh_trd1(:,:) = qgh_trd0(:,:) 194 203 ! 195 204 ELSE -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r10302 r11442 39 39 USE timing ! Timing 40 40 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 41 USE stopack 41 42 42 43 IMPLICIT NONE … … 67 68 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction (PUBLIC for TAM) 68 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_1, ahv_bbl_1 ! diffusive bbl flux coefficients at u and v-points 69 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM) 70 72 … … 86 88 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d (jpi,jpj) , mgrhv(jpi,jpj) , & 87 89 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , & 90 & ahu_bbl_1(jpi,jpj) , ahv_bbl_1(jpi,jpj) , & 88 91 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , STAT=tra_bbl_alloc ) 89 92 ! … … 195 198 ALLOCATE(zptb(1:jpi, 1:jpj)) 196 199 ! 200 ahu_bbl_1(:,:) = ahu_bbl(:,:) 201 IF( ln_stopack .AND. nn_spp_ahubbl > 0 ) THEN 202 CALL spp_gen(1, ahu_bbl_1, nn_spp_ahubbl, rn_ahubbl_sd, jk_spp_ahubbl ) 203 ENDIF 204 ahv_bbl_1(:,:) = ahv_bbl(:,:) 205 IF( ln_stopack .AND. nn_spp_ahvbbl > 0 ) THEN 206 CALL spp_gen(1, ahv_bbl_1, nn_spp_ahvbbl, rn_ahvbbl_sd, jk_spp_ahvbbl ) 207 ENDIF 208 ! 197 209 DO jn = 1, kjpt ! tracer loop 198 210 ! ! =========== … … 209 221 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,ik) 210 222 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 211 & + ( ahu_bbl (ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) &212 & - ahu_bbl (ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) &213 & + ahv_bbl (ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) &214 & - ahv_bbl (ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) * zbtr223 & + ( ahu_bbl_1(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 224 & - ahu_bbl_1(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 225 & + ahv_bbl_1(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 226 & - ahv_bbl_1(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) * zbtr 215 227 END DO 216 228 END DO … … 594 606 ahv_bbl_0(:,:) = rn_ahtbbl * e1v(:,:) * e3v_bbl_0(:,:) / e2v(:,:) * vmask(:,:,1) 595 607 596 597 608 IF( cp_cfg == "orca" ) THEN !* ORCA configuration : regional enhancement of ah_bbl 598 609 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r6498 r11442 32 32 USE wrk_nemo ! Memory allocation 33 33 USE timing ! Timing 34 USE stopack 34 35 35 36 IMPLICIT NONE … … 43 44 REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: t0_ldf, s0_ldf !: lateral diffusion trends of T & S for a cst profile 44 45 ! ! (key_traldf_ano only) 46 #if defined key_traldf_c3d 47 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: ahtu0, ahtv0, ahtw0, ahtt0 48 #endif 49 #if defined key_traldf_c2d 50 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,: ) :: ahtu0, ahtv0, ahtw0, ahtt0 51 #endif 45 52 46 53 !! * Substitutions … … 75 82 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 76 83 ENDIF 84 85 #if defined key_traldf_c3d 86 IF( ( kt == nit000 ) .AND. & 87 & ( ln_stopack ) .AND. & 88 & ( ( nn_spp_ahtu + nn_spp_ahtv + nn_spp_ahtw + nn_spp_ahtt ) > 0 ) ) THEN 89 ALLOCATE ( ahtu0(jpi,jpj,jpk), ahtv0(jpi,jpj,jpk) ) 90 ALLOCATE ( ahtt0(jpi,jpj,jpk), ahtw0(jpi,jpj,jpk) ) 91 ahtu0 = ahtu 92 ahtv0 = ahtv 93 ahtw0 = ahtw 94 ahtt0 = ahtt 95 ENDIF 96 #endif 97 #if defined key_traldf_c2d 98 IF( ( kt == nit000 ) .AND. & 99 & ( ln_stopack ) .AND. & 100 & ( ( nn_spp_ahtu + nn_spp_ahtv + nn_spp_ahtw + nn_spp_ahtt ) > 0 ) ) THEN 101 ALLOCATE ( ahtu0(jpi,jpj), ahtv0(jpi,jpj) ) 102 ALLOCATE ( ahtt0(jpi,jpj), ahtw0(jpi,jpj) ) 103 ahtu0 = ahtu 104 ahtv0 = ahtv 105 ahtw0 = ahtw 106 ahtt0 = ahtt 107 ENDIF 108 #endif 109 #if defined key_traldf_c3d || defined key_traldf_c2d 110 IF( ln_stopack .AND. ( nn_spp_ahtu > 0 ) ) THEN 111 ahtu = ahtu0 112 CALL spp_aht(kt, ahtu, nn_spp_ahtu, rn_ahtu_sd, jk_spp_ahtu) 113 ENDIF 114 IF( ln_stopack .AND. ( nn_spp_ahtv > 0 ) ) THEN 115 ahtv = ahtv0 116 CALL spp_aht(kt, ahtv, nn_spp_ahtv, rn_ahtv_sd, jk_spp_ahtv) 117 ENDIF 118 IF( ln_stopack .AND. ( nn_spp_ahtw > 0 ) ) THEN 119 ahtw = ahtw0 120 CALL spp_aht(kt, ahtw, nn_spp_ahtw, rn_ahtw_sd, jk_spp_ahtw) 121 ENDIF 122 IF( ln_stopack .AND. ( nn_spp_ahtt > 0 ) ) THEN 123 ahtt = ahtt0 124 CALL spp_aht(kt, ahtt, nn_spp_ahtt, rn_ahtt_sd, jk_spp_ahtt) 125 ENDIF 126 #endif 77 127 78 128 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r10302 r11442 33 33 USE wrk_nemo ! Memory Allocation 34 34 USE timing ! Timing 35 USE stopack 35 36 36 37 IMPLICIT NONE … … 52 53 53 54 ! Module variables 54 REAL(wp) :: xsi0r!: inverse of rn_si055 REAL(wp), ALLOCATABLE :: xsi0r(:,:) !: inverse of rn_si0 55 56 REAL(wp) :: xsi1r !: inverse of rn_si1 56 57 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) … … 182 183 ! ! ============================================== ! 183 184 ! 184 ! ! ------------------------- ! 185 ! 186 IF( ln_stopack .AND. ( nn_spp_qsi0 > 0 ) ) THEN 187 xsi0r = rn_si0 188 CALL spp_gen(kt, xsi0r, nn_spp_qsi0, rn_qsi0_sd, jk_spp_qsi0 ) 189 xsi0r = 1.e0 / xsi0r 190 ENDIF 191 ! ! ------------------------- ! 185 192 IF( ln_qsr_rgb) THEN ! R-G-B light penetration ! 186 193 ! ! ------------------------- ! … … 251 258 !CDIR NOVERRCHK 252 259 DO ji = 1, jpi 253 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r 260 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r(ji,jj) ) 254 261 zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekb(ji,jj) ) 255 262 zc2 = ze2(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * zekg(ji,jj) ) … … 285 292 DO jj = 1, jpj 286 293 DO ji = 1, jpi 287 zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r 294 zc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r(ji,jj) ) 288 295 zc1 = zcoef * EXP( - fse3t(ji,jj,1) * zekb(ji,jj) ) 289 296 zc2 = zcoef * EXP( - fse3t(ji,jj,1) * zekg(ji,jj) ) … … 310 317 ! ! ------------------------- ! 311 318 ! 312 IF( lk_vvl ) THEN !* variable volume 319 IF( lk_vvl .OR. ( ln_stopack .AND. ( nn_spp_qsi0 > 0 ) ) ) THEN !* variable volume 320 313 321 zz0 = rn_abs * r1_rau0_rcp 314 322 zz1 = ( 1. - rn_abs ) * r1_rau0_rcp … … 316 324 DO jj = 1, jpj 317 325 DO ji = 1, jpi 318 zc0 = zz0 * EXP( -fsdepw(ji,jj,jk )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r )319 zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )326 zc0 = zz0 * EXP( -fsdepw(ji,jj,jk )*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r ) 327 zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 320 328 qsr_hc(ji,jj,jk) = qsr(ji,jj) * ( zc0*tmask(ji,jj,jk) - zc1*tmask(ji,jj,jk+1) ) 321 329 END DO … … 326 334 DO jj = 1, jpj 327 335 DO ji = 1, jpi 328 zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r )329 zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r )336 zc0 = zz0 * EXP( -fsdepw(ji,jj,1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,1)*xsi1r ) 337 zc1 = zz0 * EXP( -fsdepw(ji,jj,2)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,2)*xsi1r ) 330 338 fraqsr_1lev(ji,jj) = ( zc0*tmask(ji,jj,1) - zc1*tmask(ji,jj,2) ) / r1_rau0_rcp 331 339 END DO … … 492 500 ! ! ===================================== ! 493 501 ! 502 ALLOCATE( xsi0r(jpi,jpj) ) 494 503 xsi0r = 1.e0 / rn_si0 495 504 xsi1r = 1.e0 / rn_si1 … … 546 555 !CDIR NOVERRCHK 547 556 DO ji = 1, jpi 548 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r 557 zc0 = ze0(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * xsi0r(ji,jj) ) 549 558 zc1 = ze1(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekb(ji,jj) ) 550 559 zc2 = ze2(ji,jj,jk-1) * EXP( - e3t_0(ji,jj,jk-1) * zekg(ji,jj) ) … … 587 596 DO jj = 1, jpj ! top 400 meters 588 597 DO ji = 1, jpi 589 zc0 = zz0 * EXP( -fsdepw(ji,jj,jk )*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r )590 zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r )598 zc0 = zz0 * EXP( -fsdepw(ji,jj,jk )*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk )*xsi1r ) 599 zc1 = zz0 * EXP( -fsdepw(ji,jj,jk+1)*xsi0r(ji,jj) ) + zz1 * EXP( -fsdepw(ji,jj,jk+1)*xsi1r ) 591 600 etot3(ji,jj,jk) = ( zc0 * tmask(ji,jj,jk) - zc1 * tmask(ji,jj,jk+1) ) * tmask(ji,jj,1) 592 601 END DO
Note: See TracChangeset
for help on using the changeset viewer.
