Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/TRA/trasbc.F90
- Timestamp:
- 2020-12-03T12:20:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/trasbc.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13292sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/TRA/trasbc.F90
r13295 r14037 76 76 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 77 77 ! 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices79 INTEGER :: ikt, ikb 80 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar78 INTEGER :: ji, jj, jk, jn ! dummy loop indices 79 INTEGER :: ikt, ikb, isi, iei, isj, iej ! local integers 80 REAL(wp) :: zfact, z1_e3t, zdep, ztim ! local scalar 81 81 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 82 82 !!---------------------------------------------------------------------- … … 84 84 IF( ln_timing ) CALL timing_start('tra_sbc') 85 85 ! 86 IF( kt == nit000 ) THEN 87 IF(lwp) WRITE(numout,*) 88 IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 89 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 86 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 87 IF( kt == nit000 ) THEN 88 IF(lwp) WRITE(numout,*) 89 IF(lwp) WRITE(numout,*) 'tra_sbc : TRAcer Surface Boundary Condition' 90 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 91 ENDIF 90 92 ENDIF 91 93 ! 92 94 IF( l_trdtra ) THEN !* Save ta and sa trends 93 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )95 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 94 96 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 95 97 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 96 98 ENDIF 97 99 ! 100 ! NOTE: [tiling-comms-merge] Many DO loop bounds changed to avoid changing results when using tiling. Some bounds were also adjusted to account for those changed in tra_atf 101 IF( ntsi == Nis0 ) THEN ; isi = nn_hls ; ELSE ; isi = 0 ; ENDIF ! Avoid double-counting when using tiling 102 IF( ntsj == Njs0 ) THEN ; isj = nn_hls ; ELSE ; isj = 0 ; ENDIF 103 IF( ntei == Nie0 ) THEN ; iei = nn_hls ; ELSE ; iei = 0 ; ENDIF 104 IF( ntej == Nje0 ) THEN ; iej = nn_hls ; ELSE ; iej = 0 ; ENDIF 105 98 106 !!gm This should be moved into sbcmod.F90 module ? (especially now that ln_traqsr is read in namsbc namelist) 99 107 IF( .NOT.ln_traqsr ) THEN ! no solar radiation penetration 100 qns(:,:) = qns(:,:) + qsr(:,:) ! total heat flux in qns 101 qsr(:,:) = 0._wp ! qsr set to zero 108 DO_2D( isj, iej, isi, iei ) 109 qns(ji,jj) = qns(ji,jj) + qsr(ji,jj) ! total heat flux in qns 110 qsr(ji,jj) = 0._wp ! qsr set to zero 111 END_2D 102 112 ENDIF 103 113 … … 109 119 IF( ln_rstart .AND. & ! Restart: read in restart file 110 120 & iom_varid( numror, 'sbc_hc_b', ldstop = .FALSE. ) > 0 ) THEN 111 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file'112 121 zfact = 0.5_wp 113 sbc_tsc(:,:,:) = 0._wp 114 CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content sbc trend 115 CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content sbc trend 122 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 123 IF(lwp) WRITE(numout,*) ' nit000-1 sbc tracer content field read in the restart file' 124 sbc_tsc(:,:,:) = 0._wp 125 CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 126 CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 127 ENDIF 116 128 ELSE ! No restart or restart not found: Euler forward time stepping 117 129 zfact = 1._wp 118 sbc_tsc(:,:,:) = 0._wp 119 sbc_tsc_b(:,:,:) = 0._wp 130 DO_2D( isj, iej, isi, iei ) 131 sbc_tsc(ji,jj,:) = 0._wp 132 sbc_tsc_b(ji,jj,:) = 0._wp 133 END_2D 120 134 ENDIF 121 135 ELSE !* other time-steps: swap of forcing fields 122 136 zfact = 0.5_wp 123 sbc_tsc_b(:,:,:) = sbc_tsc(:,:,:) 137 DO_2D( isj, iej, isi, iei ) 138 sbc_tsc_b(ji,jj,:) = sbc_tsc(ji,jj,:) 139 END_2D 124 140 ENDIF 125 141 ! !== Now sbc tracer content fields ==! 126 DO_2D( 0, 1, 0, 0)142 DO_2D( isj, iej, isi, iei ) 127 143 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 128 144 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 129 145 END_2D 130 146 IF( ln_linssh ) THEN !* linear free surface 131 DO_2D( 0, 1, 0, 0 )147 DO_2D( isj, iej, isi, iei ) !==>> add concentration/dilution effect due to constant volume cell 132 148 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 133 149 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) 134 END_2D 135 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 136 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 150 END_2D !==>> output c./d. term 151 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 152 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * pts(:,:,1,jp_tem,Kmm) ) 153 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * pts(:,:,1,jp_sal,Kmm) ) 154 ENDIF 137 155 ENDIF 138 156 ! 139 157 DO jn = 1, jpts !== update tracer trend ==! 140 DO_2D( 0, 1, 0, 0 ) 158 ! NOTE: [tiling-comms-merge] This looped over nn_hls, which changes the results when using tiling 159 DO_2D( 0, 0, 0, 0 ) 141 160 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) & 142 161 & / e3t(ji,jj,1,Kmm) … … 144 163 END DO 145 164 ! 146 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==!147 IF( l wxios ) CALL iom_swap( cwxios_context )148 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios)149 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios)150 IF( lwxios ) CALL iom_swap( cxios_context )165 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 166 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==! 167 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 168 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) ) 169 ENDIF 151 170 ENDIF 152 171 ! … … 157 176 IF( ln_rnf ) THEN ! input of heat and salt due to river runoff 158 177 zfact = 0.5_wp 159 DO_2D( 0, 1, 0, 0 )178 DO_2D( 0, 0, 0, 0 ) 160 179 IF( rnf(ji,jj) /= 0._wp ) THEN 161 180 zdep = zfact / h_rnf(ji,jj) … … 170 189 ENDIF 171 190 172 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 173 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 191 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only on the last tile 192 IF( iom_use('rnf_x_sst') ) CALL iom_put( "rnf_x_sst", rnf*pts(:,:,1,jp_tem,Kmm) ) ! runoff term on sst 193 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*pts(:,:,1,jp_sal,Kmm) ) ! runoff term on sss 194 ENDIF 174 195 175 196 #if defined key_asminc … … 182 203 ! 183 204 IF( ln_linssh ) THEN 184 DO_2D( 0, 1, 0, 0 )205 DO_2D( 0, 0, 0, 0 ) 185 206 ztim = ssh_iau(ji,jj) / e3t(ji,jj,1,Kmm) 186 207 pts(ji,jj,1,jp_tem,Krhs) = pts(ji,jj,1,jp_tem,Krhs) + pts(ji,jj,1,jp_tem,Kmm) * ztim … … 188 209 END_2D 189 210 ELSE 190 DO_2D( 0, 1, 0, 0 )211 DO_2D( 0, 0, 0, 0 ) 191 212 ztim = ssh_iau(ji,jj) / ( ht(ji,jj) + 1. - ssmask(ji, jj) ) 192 213 pts(ji,jj,:,jp_tem,Krhs) = pts(ji,jj,:,jp_tem,Krhs) + pts(ji,jj,:,jp_tem,Kmm) * ztim … … 204 225 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_nsr, ztrdt ) 205 226 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_nsr, ztrds ) 206 DEALLOCATE( ztrdt , ztrds ) 227 DEALLOCATE( ztrdt , ztrds ) 207 228 ENDIF 208 229 !
Note: See TracChangeset
for help on using the changeset viewer.
