- Timestamp:
- 2019-04-08T15:00:20+02:00 (5 years ago)
- Location:
- branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 5 edited
-
FABM/par_fabm.F90 (modified) (1 diff)
-
FABM/trcini_fabm.F90 (modified) (6 diffs)
-
FABM/trcsms_fabm.F90 (modified) (3 diffs)
-
trc.F90 (modified) (2 diffs)
-
trcbc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90
r10156 r10850 9 9 INTEGER, PUBLIC :: jp_fabm0, jp_fabm1, jp_fabm, & 10 10 jp_fabm_surface, jp_fabm_bottom, & 11 jp_fabm_m1 11 jp_fabm_m1, jp_fabm_2d, jp_fabm_3d 12 13 ! Variables needed for OBS/ASM 14 INTEGER, PUBLIC :: jp_fabm_chl1, jp_fabm_chl2, & 15 jp_fabm_chl3, jp_fabm_chl4, & 16 jp_fabm_p1c, jp_fabm_p1n, & 17 jp_fabm_p1p, jp_fabm_p1s, & 18 jp_fabm_p2c, jp_fabm_p2n, & 19 jp_fabm_p2p, jp_fabm_p3c, & 20 jp_fabm_p3n, jp_fabm_p3p, & 21 jp_fabm_p4c, jp_fabm_p4n, & 22 jp_fabm_p4p, jp_fabm_z4c, & 23 jp_fabm_z5c, jp_fabm_z5n, & 24 jp_fabm_z5p, jp_fabm_z6c, & 25 jp_fabm_z6n, jp_fabm_z6p, & 26 jp_fabm_n1p, jp_fabm_n3n, & 27 jp_fabm_n4n, jp_fabm_n5s, & 28 jp_fabm_o2o, jp_fabm_o3c, & 29 jp_fabm_o3ta, jp_fabm_o3ba, & 30 jp_fabm_o3pc, jp_fabm_o3ph, & 31 jp_fabm_r4n, jp_fabm_r4c, & 32 jp_fabm_r4p, jp_fabm_r6n, & 33 jp_fabm_r6c, jp_fabm_r6p, & 34 jp_fabm_r6s, jp_fabm_r8n, & 35 jp_fabm_r8c, jp_fabm_r8p, & 36 jp_fabm_r8s, & 37 jp_fabm_pgrow, jp_fabm_ploss 12 38 13 39 #if defined key_fabm -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90
r10158 r10850 65 65 jp_fabm_m1=jptra 66 66 jptra = jptra + jp_fabm 67 jpdia2d = jpdia2d + size(model%horizontal_diagnostic_variables) 68 jpdia3d = jpdia3d + size(model%diagnostic_variables) 67 jp_fabm_2d = size(model%horizontal_diagnostic_variables) 68 jp_fabm_3d = size(model%diagnostic_variables) 69 jpdia2d = jpdia2d + jp_fabm_2d 70 jpdia3d = jpdia3d + jp_fabm_3d 69 71 jpdiabio = jpdiabio + jp_fabm 70 72 71 73 !Initialize input data structures. 72 74 call initialize_inputs 75 76 ! Get indexes for select state variables 77 jp_fabm_chl1 = fabm_state_index( 'P1_Chl' ) 78 jp_fabm_chl2 = fabm_state_index( 'P2_Chl' ) 79 jp_fabm_chl3 = fabm_state_index( 'P3_Chl' ) 80 jp_fabm_chl4 = fabm_state_index( 'P4_Chl' ) 81 jp_fabm_p1c = fabm_state_index( 'P1_c' ) 82 jp_fabm_p1n = fabm_state_index( 'P1_n' ) 83 jp_fabm_p1p = fabm_state_index( 'P1_p' ) 84 jp_fabm_p1s = fabm_state_index( 'P1_s' ) 85 jp_fabm_p2c = fabm_state_index( 'P2_c' ) 86 jp_fabm_p2n = fabm_state_index( 'P2_n' ) 87 jp_fabm_p2p = fabm_state_index( 'P2_p' ) 88 jp_fabm_p3c = fabm_state_index( 'P3_c' ) 89 jp_fabm_p3n = fabm_state_index( 'P3_n' ) 90 jp_fabm_p3p = fabm_state_index( 'P3_p' ) 91 jp_fabm_p4c = fabm_state_index( 'P4_c' ) 92 jp_fabm_p4n = fabm_state_index( 'P4_n' ) 93 jp_fabm_p4p = fabm_state_index( 'P4_p' ) 94 jp_fabm_z4c = fabm_state_index( 'Z4_c' ) 95 jp_fabm_z5c = fabm_state_index( 'Z5_c' ) 96 jp_fabm_z5n = fabm_state_index( 'Z5_n' ) 97 jp_fabm_z5p = fabm_state_index( 'Z5_p' ) 98 jp_fabm_z6c = fabm_state_index( 'Z6_c' ) 99 jp_fabm_z6n = fabm_state_index( 'Z6_n' ) 100 jp_fabm_z6p = fabm_state_index( 'Z6_p' ) 101 jp_fabm_n1p = fabm_state_index( 'N1_p' ) 102 jp_fabm_n3n = fabm_state_index( 'N3_n' ) 103 jp_fabm_n4n = fabm_state_index( 'N4_n' ) 104 jp_fabm_n5s = fabm_state_index( 'N5_s' ) 105 jp_fabm_o2o = fabm_state_index( 'O2_o' ) 106 jp_fabm_o3c = fabm_state_index( 'O3_c' ) 107 jp_fabm_o3ba = fabm_state_index( 'O3_bioalk' ) 108 jp_fabm_r4n = fabm_state_index( 'R4_n' ) 109 jp_fabm_r4c = fabm_state_index( 'R4_c' ) 110 jp_fabm_r4p = fabm_state_index( 'R4_p' ) 111 jp_fabm_r6n = fabm_state_index( 'R6_n' ) 112 jp_fabm_r6c = fabm_state_index( 'R6_c' ) 113 jp_fabm_r6p = fabm_state_index( 'R6_p' ) 114 jp_fabm_r6s = fabm_state_index( 'R6_s' ) 115 jp_fabm_r8n = fabm_state_index( 'R8_n' ) 116 jp_fabm_r8c = fabm_state_index( 'R8_c' ) 117 jp_fabm_r8p = fabm_state_index( 'R8_p' ) 118 jp_fabm_r8s = fabm_state_index( 'R8_s' ) 119 120 ! Get indexes for select diagnostic variables 121 jp_fabm_o3ta = fabm_diag_index( 'O3_TA' ) 122 jp_fabm_o3ph = fabm_diag_index( 'O3_pH' ) 123 jp_fabm_o3pc = fabm_diag_index( 'O3_pCO2' ) 124 jp_fabm_pgrow = fabm_diag_index( 'p_grow_sum_result' ) 125 jp_fabm_ploss = fabm_diag_index( 'p_loss_sum_result' ) 126 127 MLD_MAX(:,:) = 0.0 128 PGROW_AVG(:,:) = 0.0 129 PLOSS_AVG(:,:) = 0.0 130 PHYT_AVG(:,:) = 0.0 73 131 74 132 IF (lwp) THEN … … 84 142 CALL write_trends_xml(xml_unit,model%state_variables(jn)) 85 143 #endif 144 CALL write_25hourm_xml(xml_unit,model%state_variables(jn)) 145 CALL write_tmb_xml(xml_unit,model%state_variables(jn)) 86 146 END DO 87 147 WRITE (xml_unit,1000) ' </field_group>' … … 90 150 DO jn=1,jp_fabm_surface 91 151 CALL write_variable_xml(xml_unit,model%surface_state_variables(jn)) 152 CALL write_25hourm_xml(xml_unit,model%surface_state_variables(jn)) 92 153 END DO 93 154 DO jn=1,jp_fabm_bottom 94 155 CALL write_variable_xml(xml_unit,model%bottom_state_variables(jn)) 156 CALL write_25hourm_xml(xml_unit,model%bottom_state_variables(jn)) 95 157 END DO 96 158 WRITE (xml_unit,1000) ' </field_group>' … … 99 161 DO jn=1,size(model%diagnostic_variables) 100 162 CALL write_variable_xml(xml_unit,model%diagnostic_variables(jn),3) 163 CALL write_25hourm_xml(xml_unit,model%diagnostic_variables(jn),3) 164 CALL write_tmb_xml(xml_unit,model%diagnostic_variables(jn)) 101 165 END DO 102 166 DO jn=1,size(model%horizontal_diagnostic_variables) 103 167 CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 168 CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 104 169 END DO 105 170 WRITE (xml_unit,1000) ' </field_group>' … … 168 233 169 234 END SUBROUTINE write_variable_xml 235 236 SUBROUTINE write_25hourm_xml(xml_unit,variable,flag_grid_ref) 237 INTEGER,INTENT(IN) :: xml_unit 238 INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 239 CLASS (type_external_variable),INTENT(IN) :: variable 240 241 CHARACTER(LEN=20) :: missing_value,string_dimensions 242 INTEGER :: number_dimensions 243 244 ! Check variable dimension for grid_ref specificaiton. 245 ! Default is to not specify the grid_ref in the field definition. 246 IF (present(flag_grid_ref)) THEN 247 number_dimensions=flag_grid_ref 248 ELSE 249 number_dimensions=-1 !default, don't specify grid_ref 250 ENDIF 251 252 WRITE (missing_value,'(E9.3)') 1.e+20 253 WRITE (string_dimensions,'(I1)') number_dimensions 254 SELECT CASE (number_dimensions) 255 CASE (3) 256 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 257 CASE (2) 258 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 259 CASE (0) 260 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="1point"/>' 261 CASE (-1) 262 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" />' 263 CASE default 264 IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise output of variable '//TRIM(variable%name)//'25h'//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional variables not supported!!!' 265 END SELECT 266 267 END SUBROUTINE write_25hourm_xml 268 269 SUBROUTINE write_tmb_xml(xml_unit,variable) 270 INTEGER,INTENT(IN) :: xml_unit 271 CLASS (type_external_variable),INTENT(IN) :: variable 272 273 CHARACTER(LEN=20) :: missing_value 274 275 WRITE (missing_value,'(E9.3)') 1.e+20 276 WRITE (xml_unit,'(A)') ' <field id="top_'//TRIM(variable%name)//'" long_name="Top-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 277 WRITE (xml_unit,'(A)') ' <field id="mid_'//TRIM(variable%name)//'" long_name="Middle-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 278 WRITE (xml_unit,'(A)') ' <field id="bot_'//TRIM(variable%name)//'" long_name="Bottom-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 279 280 END SUBROUTINE write_tmb_xml 170 281 171 282 SUBROUTINE write_trends_xml(xml_unit,variable,flag_grid_ref) … … 328 439 END SUBROUTINE trc_ini_fabm 329 440 441 INTEGER FUNCTION fabm_state_index( state_name ) 442 !!---------------------------------------------------------------------- 443 !! *** fabm_state_index *** 444 !! 445 !! ** Purpose : return index of a given FABM state variable 446 !! 447 !! ** Method : - loop through state variables until found 448 !!---------------------------------------------------------------------- 449 450 IMPLICIT NONE 451 452 CHARACTER(LEN=256), INTENT(IN) :: state_name 453 454 INTEGER :: jn 455 456 !!---------------------------------------------------------------------- 457 458 fabm_state_index = -1 459 DO jn=1,jp_fabm 460 IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 461 fabm_state_index = jn 462 EXIT 463 ENDIF 464 END DO 465 IF (fabm_state_index == -1) THEN 466 CALL ctl_warn( 'Could not find '//TRIM(state_name)//' state variable' ) 467 ELSE 468 IF (lwp) WRITE(numout,*) 'Index for '//TRIM(state_name)//' is: ', fabm_state_index 469 ENDIF 470 471 END FUNCTION fabm_state_index 472 473 INTEGER FUNCTION fabm_diag_index( diag_name ) 474 !!---------------------------------------------------------------------- 475 !! *** fabm_state_index *** 476 !! 477 !! ** Purpose : return index of a given FABM diagnostic variable 478 !! 479 !! ** Method : - loop through diagnostic variables until found 480 !!---------------------------------------------------------------------- 481 482 IMPLICIT NONE 483 484 CHARACTER(LEN=256), INTENT(IN) :: diag_name 485 486 INTEGER :: jn 487 488 !!---------------------------------------------------------------------- 489 490 fabm_diag_index = -1 491 DO jn = 1, SIZE(model%diagnostic_variables) 492 IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 493 fabm_diag_index = jn 494 EXIT 495 ENDIF 496 END DO 497 IF (fabm_diag_index == -1) THEN 498 CALL ctl_warn( 'Could not find '//TRIM(diag_name)//' diagnostic' ) 499 ELSE 500 IF (lwp) WRITE(numout,*) 'Index for '//TRIM(diag_name)//' is: ', fabm_diag_index 501 ENDIF 502 503 END FUNCTION fabm_diag_index 504 330 505 #else 331 506 !!---------------------------------------------------------------------- -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/trcsms_fabm.F90
r10156 r10850 33 33 USE inputs_fabm 34 34 USE vertical_movement_fabm 35 USE zdfmxl 36 USE asmbgc, ONLY: mld_choice_bgc 37 USE lbclnk 35 38 36 39 !USE fldread ! time interpolation … … 113 116 114 117 CALL st2d_fabm_nxt( kt ) 118 119 CALL asmdiags_fabm( kt ) 115 120 116 121 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrfabm ) … … 130 135 131 136 END SUBROUTINE trc_sms_fabm 137 138 SUBROUTINE asmdiags_fabm( kt ) 139 INTEGER, INTENT(IN) :: kt 140 INTEGER :: ji,jj,jk,jkmax 141 REAL(wp), DIMENSION(jpi,jpj,jpk) :: pgrow_3d, ploss_3d, zmld 142 143 IF (kt == nittrc000) THEN 144 MLD_MAX(:,:) = 0.0 145 ENDIF 146 PGROW_AVG(:,:) = 0.0 147 PLOSS_AVG(:,:) = 0.0 148 PHYT_AVG(:,:) = 0.0 149 150 pgrow_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_pgrow) 151 ploss_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_ploss) 152 153 SELECT CASE( mld_choice_bgc ) 154 CASE ( 1 ) ! Turbocline/mixing depth [W points] 155 zmld(:,:) = hmld(:,:) 156 CASE ( 2 ) ! Density criterion (0.01 kg/m^3 change from 10m) [W points] 157 zmld(:,:) = hmlp(:,:) 158 CASE ( 3 ) ! Kara MLD [Interpolated] 159 #if defined key_karaml 160 IF ( ln_kara ) THEN 161 zmld(:,:) = hmld_kara(:,:) 162 ELSE 163 CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 164 & ' but ln_kara=.false.' ) 165 ENDIF 166 #else 167 CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 168 & ' but is not defined' ) 169 #endif 170 CASE ( 4 ) ! Temperature criterion (0.2 K change from surface) [T points] 171 zmld(:,:) = hmld_tref(:,:) 172 CASE ( 5 ) ! Density criterion (0.01 kg/m^3 change from 10m) [T points] 173 zmld(:,:) = hmlpt(:,:) 174 END SELECT 175 176 DO jj = 2, jpjm1 177 DO ji = 2, jpim1 178 ! 179 jkmax = jpk-1 180 DO jk = jpk-1, 1, -1 181 IF ( ( zmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 182 & ( zmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 183 zmld(ji,jj) = gdepw_n(ji,jj,jk+1) 184 jkmax = jk 185 ENDIF 186 END DO 187 ! 188 DO jk = 1, jkmax 189 PHYT_AVG(ji,jj) = PHYT_AVG(ji,jj) + & 190 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n) + & 191 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n) + & 192 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n) + & 193 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n) 194 IF ( pgrow_3d(ji,jj,jk) .GT. 0.0 ) THEN 195 PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) + & 196 & pgrow_3d(ji,jj,jk) 197 ENDIF 198 IF ( ploss_3d(ji,jj,jk) .GT. 0.0 ) THEN 199 PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) + & 200 & ploss_3d(ji,jj,jk) 201 ENDIF 202 END DO 203 204 PHYT_AVG(ji,jj) = PHYT_AVG(ji,jj) / REAL(jkmax) 205 PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) / REAL(jkmax) 206 PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) / REAL(jkmax) 207 208 IF ( zmld(ji,jj) .GT. MLD_MAX(ji,jj) ) THEN 209 MLD_MAX(ji,jj) = zmld(ji,jj) 210 ENDIF 211 ! 212 END DO 213 END DO 214 215 PHYT_AVG(:,:) = PHYT_AVG(:,:) * tmask(:,:,1) 216 PGROW_AVG(:,:) = PGROW_AVG(:,:) * tmask(:,:,1) 217 PLOSS_AVG(:,:) = PLOSS_AVG(:,:) * tmask(:,:,1) 218 MLD_MAX(:,:) = MLD_MAX(:,:) * tmask(:,:,1) 219 220 END SUBROUTINE asmdiags_fabm 132 221 133 222 SUBROUTINE compute_fabm() -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/trc.F90
r10162 r10850 225 225 #endif 226 226 227 #if defined key_fabm 228 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: PGROW_AVG !: Phytoplankton growth for use in ASM code 229 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: PLOSS_AVG !: Phytoplankton loss for use in ASM code 230 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: PHYT_AVG !: Phytoplankton for use in ASM code 231 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: MLD_MAX !: Maximum MLD for use in ASM code 232 #endif 233 227 234 !!---------------------------------------------------------------------- 228 235 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) … … 253 260 ! FABM <<<+++ 254 261 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & 262 & PGROW_AVG(jpi,jpj) , PLOSS_AVG(jpi,jpj) , PHYT_AVG(jpi,jpj) , & 263 & MLD_MAX(jpi,jpj) , & 255 264 #endif 256 265 #if defined key_bdy -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r10162 r10850 46 46 # include "domzgr_substitute.h90" 47 47 !!---------------------------------------------------------------------- 48 !! NEMO/OPA 3. 6 , NEMO Consortium (2015)48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 49 49 !! $Id$ 50 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
Note: See TracChangeset
for help on using the changeset viewer.
