Changeset 7716 for branches/UKMO/dev_r5518_v3.4_asm_nemovar_community_bgc_ersem/NEMOGCM/NEMO/OPA_SRC/ASM/asmlogchlbal_ersem.F90
- Timestamp:
- 2017-02-22T16:11:16+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_v3.4_asm_nemovar_community_bgc_ersem/NEMOGCM/NEMO/OPA_SRC/ASM/asmlogchlbal_ersem.F90
r7045 r7716 20 20 USE trc, ONLY: trn ! ERSEM state variables 21 21 USE par_fabm ! FABM parameters 22 USE par_trc, ONLY: jptra ! Tracer parameters 22 23 23 24 IMPLICIT NONE … … 30 31 CONTAINS 31 32 32 SUBROUTINE asm_logchl_bal_ersem( ln_logchlpftinc, npfts, & 33 & mld_choice_bgc, logchl_bkginc, & 34 & logchl_balinc_ersem_chl1, logchl_balinc_ersem_chl2, & 35 & logchl_balinc_ersem_chl3, logchl_balinc_ersem_chl4, & 36 & logchl_balinc_ersem_p1c, logchl_balinc_ersem_p1n, & 37 & logchl_balinc_ersem_p1p, logchl_balinc_ersem_p1s, & 38 & logchl_balinc_ersem_p2c, logchl_balinc_ersem_p2n, & 39 & logchl_balinc_ersem_p2p, logchl_balinc_ersem_p3c, & 40 & logchl_balinc_ersem_p3n, logchl_balinc_ersem_p3p, & 41 & logchl_balinc_ersem_p4c, logchl_balinc_ersem_p4n, & 42 & logchl_balinc_ersem_p4p, logchl_balinc_ersem_z4c, & 43 & logchl_balinc_ersem_z5c, logchl_balinc_ersem_z5n, & 44 & logchl_balinc_ersem_z5p, logchl_balinc_ersem_z6c, & 45 & logchl_balinc_ersem_z6n, logchl_balinc_ersem_z6p, & 46 & logchl_balinc_ersem_n1p, logchl_balinc_ersem_n3n, & 47 & logchl_balinc_ersem_n4n, logchl_balinc_ersem_n5s ) 33 SUBROUTINE asm_logchl_bal_ersem( ln_logchlpftinc, npfts, mld_choice_bgc, & 34 & logchl_bkginc, logchl_balinc ) 48 35 !!--------------------------------------------------------------------------- 49 36 !! *** ROUTINE asm_logchl_bal_ersem *** … … 58 45 !!--------------------------------------------------------------------------- 59 46 !! 60 LOGICAL, INTENT(in ) :: ln_logchlpftinc 61 INTEGER, INTENT(in ) :: npfts 62 INTEGER, INTENT(in ) :: mld_choice_bgc 63 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,npfts) :: logchl_bkginc 64 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_chl1 65 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_chl2 66 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_chl3 67 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_chl4 68 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p1c 69 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p1n 70 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p1p 71 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p1s 72 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p2c 73 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p2n 74 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p2p 75 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p3c 76 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p3n 77 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p3p 78 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p4c 79 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p4n 80 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_p4p 81 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_z4c 82 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_z5c 83 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_z5n 84 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_z5p 85 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_z6c 86 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_z6n 87 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_z6p 88 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_n1p 89 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_n3n 90 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_n4n 91 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk) :: logchl_balinc_ersem_n5s 47 LOGICAL, INTENT(in ) :: ln_logchlpftinc 48 INTEGER, INTENT(in ) :: npfts 49 INTEGER, INTENT(in ) :: mld_choice_bgc 50 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj,npfts) :: logchl_bkginc 51 REAL(wp), INTENT( out), DIMENSION(jpi,jpj,jpk,jptra) :: logchl_balinc 92 52 !! 93 53 INTEGER :: ji, jj, jk … … 98 58 99 59 ! Split surface logchl incs into surface Chl1-4 incs 60 ! 61 ! In order to transform logchl incs to chl incs, need to account for the background, 62 ! cannot simply do 10^logchl_bkginc. Need to: 63 ! 1) Add logchl inc to log10(background) to get log10(analysis) 64 ! 2) Take 10^log10(analysis) to get analysis 65 ! 3) Subtract background from analysis to get chl incs 100 66 ! 101 67 IF ( ln_logchlpftinc ) THEN … … 108 74 DO jj = 1, jpj 109 75 DO ji = 1, jpi 110 IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) > 0.0 ) THEN 111 logchl_balinc_ersem_chl1(ji,jj,1) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) + & 112 & tiny ) + logchl_bkginc(ji,jj,1) ) - & 113 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) - tiny 114 ENDIF 115 IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) > 0.0 ) THEN 116 logchl_balinc_ersem_chl2(ji,jj,1) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) + & 117 & tiny ) + logchl_bkginc(ji,jj,2) ) - & 118 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) - tiny 119 ENDIF 120 IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) > 0.0 ) THEN 121 logchl_balinc_ersem_chl3(ji,jj,1) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) + & 122 & tiny ) + logchl_bkginc(ji,jj,3) ) - & 123 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) - tiny 124 ENDIF 125 IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) > 0.0 ) THEN 126 logchl_balinc_ersem_chl4(ji,jj,1) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) + & 127 & tiny ) + logchl_bkginc(ji,jj,4) ) - & 128 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) - tiny 76 IF ( ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) > 0.0 ) .AND. & 77 & ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) > 0.0 ) .AND. & 78 & ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) > 0.0 ) .AND. & 79 & ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) > 0.0 ) ) THEN 80 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) ) + & 81 & logchl_bkginc(ji,jj,1) ) - & 82 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) 83 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) ) + & 84 & logchl_bkginc(ji,jj,2) ) - & 85 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) 86 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) ) + & 87 & logchl_bkginc(ji,jj,3) ) - & 88 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) 89 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) = 10**( LOG10( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) ) + & 90 & logchl_bkginc(ji,jj,4) ) - & 91 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) 129 92 ENDIF 130 93 END DO … … 135 98 ! and split between PFTs according to the existing background ratios 136 99 ! 100 IF ( npfts /= 1 ) THEN 101 CALL ctl_stop( 'If assimilating total chlorophyll, nn_asmpfts must be 1' ) 102 ENDIF 137 103 DO jj = 1, jpj 138 104 DO ji = 1, jpi … … 143 109 chl_tot = trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) + trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) + & 144 110 & trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) + trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) 145 chl_inc = 10**( LOG10( chl_tot + tiny ) + logchl_bkginc(ji,jj,1) ) - chl_tot - tiny146 logchl_balinc _ersem_chl1(ji,jj,1) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) / chl_tot147 logchl_balinc _ersem_chl2(ji,jj,1) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) / chl_tot148 logchl_balinc _ersem_chl3(ji,jj,1) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) / chl_tot149 logchl_balinc _ersem_chl4(ji,jj,1) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) / chl_tot111 chl_inc = 10**( LOG10( chl_tot ) + logchl_bkginc(ji,jj,1) ) - chl_tot 112 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) / chl_tot 113 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) / chl_tot 114 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) / chl_tot 115 logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) = chl_inc * trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) / chl_tot 150 116 ENDIF 151 117 END DO … … 194 160 ! 195 161 DO jk = 2, jkmax 196 logchl_balinc _ersem_chl1(ji,jj,jk) = logchl_balinc_ersem_chl1(ji,jj,1)197 logchl_balinc _ersem_chl2(ji,jj,jk) = logchl_balinc_ersem_chl2(ji,jj,1)198 logchl_balinc _ersem_chl3(ji,jj,jk) = logchl_balinc_ersem_chl3(ji,jj,1)199 logchl_balinc _ersem_chl4(ji,jj,jk) = logchl_balinc_ersem_chl4(ji,jj,1)162 logchl_balinc(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) = logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) 163 logchl_balinc(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) = logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) 164 logchl_balinc(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) = logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) 165 logchl_balinc(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) = logchl_balinc(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) 200 166 END DO 201 167 ! … … 203 169 END DO 204 170 205 ! Balance P[1-4][c,n,p,s] 206 ! Maintain existing background ratios 207 ! 208 !DO jk = 1, jpk 209 ! DO jj = 1, jpj 210 ! DO ji = 1, jpi 211 ! IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl1) > 0.0 ) THEN 212 ! logchl_balinc_ersem_p1c(ji,jj,jk) = logchl_balinc_ersem_chl1(ji,jj,jk) * & 213 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p1c) / & 214 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) 215 ! logchl_balinc_ersem_p1n(ji,jj,jk) = logchl_balinc_ersem_chl1(ji,jj,jk) * & 216 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n) / & 217 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) 218 ! logchl_balinc_ersem_p1p(ji,jj,jk) = logchl_balinc_ersem_chl1(ji,jj,jk) * & 219 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p1p) / & 220 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) 221 ! logchl_balinc_ersem_p1s(ji,jj,jk) = logchl_balinc_ersem_chl1(ji,jj,jk) * & 222 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p1s) / & 223 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl1) 224 ! ENDIF 225 ! IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl2) > 0.0 ) THEN 226 ! logchl_balinc_ersem_p2c(ji,jj,jk) = logchl_balinc_ersem_chl2(ji,jj,jk) * & 227 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p2c) / & 228 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) 229 ! logchl_balinc_ersem_p2n(ji,jj,jk) = logchl_balinc_ersem_chl2(ji,jj,jk) * & 230 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n) / & 231 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) 232 ! logchl_balinc_ersem_p2p(ji,jj,jk) = logchl_balinc_ersem_chl2(ji,jj,jk) * & 233 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p2p) / & 234 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl2) 235 ! ENDIF 236 ! IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl3) > 0.0 ) THEN 237 ! logchl_balinc_ersem_p3c(ji,jj,jk) = logchl_balinc_ersem_chl3(ji,jj,jk) * & 238 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p3c) / & 239 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) 240 ! logchl_balinc_ersem_p3n(ji,jj,jk) = logchl_balinc_ersem_chl3(ji,jj,jk) * & 241 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n) / & 242 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) 243 ! logchl_balinc_ersem_p3p(ji,jj,jk) = logchl_balinc_ersem_chl3(ji,jj,jk) * & 244 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p3p) / & 245 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl3) 246 ! ENDIF 247 ! IF ( trn(ji,jj,1,jp_fabm_m1+jp_fabm_chl4) > 0.0 ) THEN 248 ! logchl_balinc_ersem_p4c(ji,jj,jk) = logchl_balinc_ersem_chl4(ji,jj,jk) * & 249 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p4c) / & 250 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) 251 ! logchl_balinc_ersem_p4n(ji,jj,jk) = logchl_balinc_ersem_chl4(ji,jj,jk) * & 252 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n) / & 253 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) 254 ! logchl_balinc_ersem_p4p(ji,jj,jk) = logchl_balinc_ersem_chl4(ji,jj,jk) * & 255 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p4p) / & 256 ! & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_chl4) 257 ! ENDIF 258 ! END DO 259 ! END DO 260 !END DO 171 ! Multivariate balancing forthcoming... 261 172 262 173 END SUBROUTINE asm_logchl_bal_ersem … … 267 178 !!---------------------------------------------------------------------- 268 179 CONTAINS 269 SUBROUTINE asm_logchl_bal_ersem( ln_logchlpftinc, npfts, & 270 & mld_choice_bgc, logchl_bkginc, & 271 & logchl_balinc_ersem_chl1, logchl_balinc_ersem_chl2, & 272 & logchl_balinc_ersem_chl3, logchl_balinc_ersem_chl4, & 273 & logchl_balinc_ersem_p1c, logchl_balinc_ersem_p1n, & 274 & logchl_balinc_ersem_p1p, logchl_balinc_ersem_p1s, & 275 & logchl_balinc_ersem_p2c, logchl_balinc_ersem_p2n, & 276 & logchl_balinc_ersem_p2p, logchl_balinc_ersem_p3c, & 277 & logchl_balinc_ersem_p3n, logchl_balinc_ersem_p3p, & 278 & logchl_balinc_ersem_p4c, logchl_balinc_ersem_p4n, & 279 & logchl_balinc_ersem_p4p, logchl_balinc_ersem_z4c, & 280 & logchl_balinc_ersem_z5c, logchl_balinc_ersem_z5n, & 281 & logchl_balinc_ersem_z5p, logchl_balinc_ersem_z6c, & 282 & logchl_balinc_ersem_z6n, logchl_balinc_ersem_z6p, & 283 & logchl_balinc_ersem_n1p, logchl_balinc_ersem_n3n, & 284 & logchl_balinc_ersem_n4n, logchl_balinc_ersem_n5s ) 180 SUBROUTINE asm_logchl_bal_ersem( ln_logchlpftinc, npfts, mld_choice_bgc, & 181 & logchl_bkginc, logchl_balinc ) 285 182 LOGICAL :: ln_logchlpftinc 286 183 INTEGER :: npfts 287 184 INTEGER :: mld_choice_bgc 288 185 REAL :: logchl_bkginc(:,:,:) 289 REAL :: logchl_balinc_ersem_chl1(:,:,:), logchl_balinc_ersem_chl2(:,:,:) 290 REAL :: logchl_balinc_ersem_chl3(:,:,:), logchl_balinc_ersem_chl4(:,:,:) 291 REAL :: logchl_balinc_ersem_p1c(:,:,:), logchl_balinc_ersem_p1n(:,:,:) 292 REAL :: logchl_balinc_ersem_p1p(:,:,:), logchl_balinc_ersem_p1s(:,:,:) 293 REAL :: logchl_balinc_ersem_p2c(:,:,:), logchl_balinc_ersem_p2n(:,:,:) 294 REAL :: logchl_balinc_ersem_p2p(:,:,:), logchl_balinc_ersem_p3c(:,:,:) 295 REAL :: logchl_balinc_ersem_p3n(:,:,:), logchl_balinc_ersem_p3p(:,:,:) 296 REAL :: logchl_balinc_ersem_p4c(:,:,:), logchl_balinc_ersem_p4n(:,:,:) 297 REAL :: logchl_balinc_ersem_p4p(:,:,:), logchl_balinc_ersem_z4c(:,:,:) 298 REAL :: logchl_balinc_ersem_z5c(:,:,:), logchl_balinc_ersem_z5n(:,:,:) 299 REAL :: logchl_balinc_ersem_z5p(:,:,:), logchl_balinc_ersem_z6c(:,:,:) 300 REAL :: logchl_balinc_ersem_z6n(:,:,:), logchl_balinc_ersem_z6p(:,:,:) 301 REAL :: logchl_balinc_ersem_n1p(:,:,:), logchl_balinc_ersem_n3n(:,:,:) 302 REAL :: logchl_balinc_ersem_n4n(:,:,:), logchl_balinc_ersem_n5s ) 186 REAL :: logchl_balinc(:,:,:,:) 303 187 WRITE(*,*) 'asm_logchl_bal_ersem: You should not have seen this print! error?' 304 188 END SUBROUTINE asm_logchl_bal_ersem
Note: See TracChangeset
for help on using the changeset viewer.
