Changeset 15445 for NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE
- Timestamp:
- 2021-10-26T11:01:34+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_CO9_shelf_climate/src/OCE/TRA/tradwl.F90
r15318 r15445 80 80 REAL(wp) :: zc0, zc1, zc2, zc3 ! - - 81 81 !JT 82 REAL(wp) :: hbatt82 REAL(wp), DIMENSION(jpi,jpj) :: hbatt, qsr_tradwl 83 83 !JT 84 REAL(wp), DIMENSION(jpi,jpj) :: zekb, zekg, zekr ! 2D workspace85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze0, ze1 , ze2, ze3, zea ! 3D workspace86 84 !!---------------------------------------------------------------------- 87 85 !! HERE GO VARIABLES USED IN POLCOMS CLEAN UP LATER … … 120 118 ! 121 119 !--------------------------------------------------------------------------- 122 120 !cp=3986.0d0 123 121 124 122 DO jj = 2, jpj 125 123 DO ji = fs_2, fs_jpim1 126 qsr (ji,jj) = qsr(ji,jj) * (r1_rau0_rcp)124 qsr_tradwl(ji,jj) = qsr(ji,jj) * (r1_rau0_rcp) 127 125 ENDDO !ji 128 126 ENDDO !jj 129 127 !-------------------------------------------------------------------------------- 130 if ( first ) then 128 129 130 if ( first ) then 131 do jj=2,jpjm1 132 do ji = fs_2, fs_jpim1 133 IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land 134 hbatt(ji,jj) = sum( e3t_n(ji,jj,:)*tmask(ji,jj,:) ) 135 else 136 hbatt(ji,jj)= 0. 137 endif 138 enddo ! ji 139 enddo ! jj 140 141 !CALL iom_put('hbatt_tradwl', hbatt(:,:) ) 142 131 143 rlambda2(:,:) = 0.0 132 144 first=.false. 133 145 if ( ln_vary_lambda ) then 134 ! do j=1,jesub ! Original Polcoms style Loop135 ! do i=1,iesub ! Original Polcoms style Loop136 146 137 147 do jj=2,jpjm1 138 148 do ji = fs_2, fs_jpim1 ! vector opt. 139 if (tmask(ji,jj,0) == 1) then 140 141 ! if(ipexb(i,j).ne. 0) then (Mask, use Tmask instead) 142 143 144 !JT 145 !hbatt = gdept_n(ji,jj, k_bot(ji,jj) ) 146 hbatt = sum( e3t_n(ji,jj,:)*tmask(ji,jj,:) ) 147 148 rlambda2(ji,jj)=-0.033*log(hbatt)+0.2583 ! JIAs formula 149 !JT 150 151 152 !JT rlambda2(ji,jj)=-0.033*log(hbatt(ji,jj))+0.2583 ! JIAs formula 149 !IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land 150 151 152 rlambda2(ji,jj)=-0.033*log(hbatt(ji,jj))+0.2583 ! JIAs formula 153 153 rlambda2(ji,jj)=max(0.05,rlambda2(ji,jj)) ! limit in deep water 154 154 rlambda2(ji,jj)=min(0.25,rlambda2(ji,jj)) ! Catch the infinities, from very shallow water/land. 10cm = 0.25 155 155 156 !WRITE(*,300) 'JT tradwl:',jj,ji,njmpp,jpjglo,nimpp,jpiglo,narea, hbatt, rlambda2(ji,jj) 157 !300 FORMAT(A14,1X,I4,1X,I4,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,f9.3,1X,f9.2) 158 159 160 ! WRITE(*,300) 'JT tradwl:',jj,ji,njmpp+jj,nimpp+ji,njmpp,nimpp,narea, hbatt, rlambda2(ji,jj) 161 !domain size jpjglo,,jpiglo 162 !lower lhs of each sub-domain = nimpp,njmpp 163 ! index on the global domain??? add or subtract one?? = njmpp+jj,nimpp+ji 164 !300 FORMAT(A14,1X,I4,1X,I4,1X,I5,1X,I5,1X,I5,1X,I5,1X,I5,1X,f9.3,1X,f9.2) 165 166 167 ! if (kt == 1) WRITE(*,300) 'JT tradwl:',njmpp+jj,nimpp+ji, hbatt, rlambda2(ji,jj) 168 !domain size jpjglo,,jpiglo 169 !lower lhs of each sub-domain = nimpp,njmpp 170 ! index on the global domain??? add or subtract one?? = njmpp+jj,nimpp+ji 171 !300 FORMAT(A14,1X,I4,1X,I4,1X,f9.3,1X,f9.2) 172 173 174 else 175 rlambda2(ji,jj)= 0.25 176 endif 156 !else 157 ! rlambda2(ji,jj)= 0.25 158 !endif 177 159 enddo ! ji 178 160 enddo ! jj … … 183 165 endif ! If first 184 166 185 ! do j=1,jesub ! Original Polcoms Style Loop 186 ! do i=1,iesub ! Original Polcoms Style Loop 167 ! CALL iom_put('rlambda2_tradwl', rlambda2(:,:) ) 168 187 169 DO jk=2,jpk 188 170 DO jj=2,jpjm1 189 171 DO ji = fs_2, fs_jpim1 ! vector opt. 190 172 191 if (tmask(ji,jj,0) == 1) then 173 IF ( tmask(ji,jj,1) .EQ. 1) THEN ! if land 174 192 175 !-------------------------------------------------------------------- 193 176 ! Calculate change in temperature … … 196 179 ! rad0 = hfl_in(i,j) ! change hfl_in to qsr I assume 197 180 198 rad0 = qsr (ji,jj)181 rad0 = qsr_tradwl(ji,jj) 199 182 rD = rLambda2(ji,jj) +rLambda ! Transmissivity to be used here 200 ! if rlambda 0 then rlambda2 not zer and vica versa183 ! if rlambda 0 then rlambda2 not zer and vica versa 201 184 202 185 z2=gdepw_0(ji,jj,jk-1) ! grid box is from z=z1 to z=z2 … … 209 192 dtmp(jk)=1.0/(e3t_0(ji,jj,jk))*(Rad2-Rad1) !change in temperature 210 193 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + dtmp(jk) 211 endif 194 endif ! if land 212 195 enddo ! ji 213 196 enddo ! jj … … 249 232 REAL(wp) :: zc2 , zc3 , zchl ! - - 250 233 REAL(wp) :: zsi0r, zsi1r, zcoef ! - - 251 REAL(wp), DIMENSION(jpi,jpj) :: zekb, zekg, zekr ! 2D workspace252 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze0 , ze1 , ze2 , ze3 , zea ! 3D workspace253 234 !! 254 235 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
Note: See TracChangeset
for help on using the changeset viewer.