Changeset 8049
- Timestamp:
- 2017-05-19T15:32:50+02:00 (7 years ago)
- Location:
- branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO
- Files:
-
- 15 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r7590 r8049 21 21 #endif 22 22 USE diatmb 23 #if defined key_fabm 24 USE trc, ONLY: trn 25 USE par_fabm 26 USE fabm, ONLY: fabm_get_bulk_diagnostic_data 27 #endif 23 28 24 29 IMPLICIT NONE … … 39 44 #if defined key_zdfgls 40 45 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: rmxln_25h 46 #endif 47 #if defined key_fabm 48 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: fabm3d_25h 41 49 #endif 42 50 INTEGER, SAVE :: cnt_25h ! Counter for 25 hour means … … 145 153 CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' ) ; RETURN 146 154 ENDIF 155 #if defined key_fabm 156 ALLOCATE( fabm3d_25h(jpi,jpj,jpk,jp_fabmdia_3dout), STAT=ierror ) 157 IF( ierror > 0 ) THEN 158 CALL ctl_stop( 'dia_tide: unable to allocate fabm3d_25h' ) ; RETURN 159 ENDIF 160 #endif 147 161 ! ------------------------- ! 148 162 ! 2 - Assign Initial Values ! … … 169 183 rmxln_25h(:,:,:) = mxln(:,:,:) 170 184 #endif 185 #if defined key_fabm 186 fabm3d_25h(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_n1p) 187 fabm3d_25h(:,:,:,2) = trn(:,:,:,jp_fabm_m1+jp_fabm_n3n) 188 fabm3d_25h(:,:,:,3) = trn(:,:,:,jp_fabm_m1+jp_fabm_n4n) 189 fabm3d_25h(:,:,:,4) = trn(:,:,:,jp_fabm_m1+jp_fabm_n5s) 190 fabm3d_25h(:,:,:,5) = trn(:,:,:,jp_fabm_m1+jp_fabm_o2o) 191 fabm3d_25h(:,:,:,6)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3ph) 192 fabm3d_25h(:,:,:,7)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) 193 fabm3d_25h(:,:,:,8)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) 194 fabm3d_25h(:,:,:,9)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_netpp) 195 fabm3d_25h(:,:,:,10)= fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps) 196 fabm3d_25h(:,:,:,11)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_phytot) 197 #endif 171 198 #if defined key_lim3 || defined key_lim2 172 199 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') … … 268 295 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 269 296 #endif 297 #if defined key_fabm 298 fabm3d_25h(:,:,:,1) = fabm3d_25h(:,:,:,1) + trn(:,:,:,jp_fabm_m1+jp_fabm_n1p) ! phosphate 299 fabm3d_25h(:,:,:,2) = fabm3d_25h(:,:,:,2) + trn(:,:,:,jp_fabm_m1+jp_fabm_n3n) ! nitrate 300 fabm3d_25h(:,:,:,3) = fabm3d_25h(:,:,:,3) + trn(:,:,:,jp_fabm_m1+jp_fabm_n4n) ! ammonium 301 fabm3d_25h(:,:,:,4) = fabm3d_25h(:,:,:,4) + trn(:,:,:,jp_fabm_m1+jp_fabm_n5s) ! silicate 302 fabm3d_25h(:,:,:,5) = fabm3d_25h(:,:,:,5) + trn(:,:,:,jp_fabm_m1+jp_fabm_o2o) ! oxygen 303 fabm3d_25h(:,:,:,6)= fabm3d_25h(:,:,:,6) + fabm_get_bulk_diagnostic_data(model, jp_fabm_o3ph) ! pH 304 fabm3d_25h(:,:,:,7)= fabm3d_25h(:,:,:,7) + fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) ! pCO2 305 fabm3d_25h(:,:,:,8)= fabm3d_25h(:,:,:,8) + fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) ! total Chl 306 fabm3d_25h(:,:,:,9)= fabm3d_25h(:,:,:,9) + fabm_get_bulk_diagnostic_data(model, jp_fabmdia_netpp) ! netPP 307 fabm3d_25h(:,:,:,10)= fabm3d_25h(:,:,:,10) + fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps) ! light attenuation 308 fabm3d_25h(:,:,:,11)= fabm3d_25h(:,:,:,11) + fabm_get_bulk_diagnostic_data(model, jp_fabmdia_phytot) ! total phytoplankton 309 #endif 270 310 cnt_25h = cnt_25h + 1 271 311 … … 300 340 # if defined key_zdfgls 301 341 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 342 #endif 343 #if defined key_fabm 344 fabm3d_25h(:,:,:,:) = fabm3d_25h(:,:,:,:) / 25.0_wp 302 345 #endif 303 346 … … 319 362 CALL iom_put( "ssh25h", zw2d ) ! sea surface 320 363 364 #if defined key_fabm 365 ! Write ERSEM variables 366 zw3d(:,:,:) = fabm3d_25h(:,:,:,1)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 367 CALL iom_put( "N1p25h", zw3d ) ! phosphate 368 zw3d(:,:,:) = fabm3d_25h(:,:,:,2)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 369 CALL iom_put( "N3n25h", zw3d ) ! nitrate 370 zw3d(:,:,:) = fabm3d_25h(:,:,:,3)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 371 CALL iom_put( "N4n25h", zw3d ) ! ammonium 372 zw3d(:,:,:) = fabm3d_25h(:,:,:,4)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 373 CALL iom_put( "N5s25h", zw3d ) ! silicate 374 zw3d(:,:,:) = fabm3d_25h(:,:,:,5)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 375 CALL iom_put( "O2o25h", zw3d ) ! oxygen 376 zw3d(:,:,:) = fabm3d_25h(:,:,:,6)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 377 CALL iom_put( "pH25h", zw3d ) ! pH 378 zw3d(:,:,:) = fabm3d_25h(:,:,:,7)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 379 CALL iom_put( "pCO2_25h", zw3d ) ! pCO2 380 zw3d(:,:,:) = fabm3d_25h(:,:,:,8)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 381 CALL iom_put( "CHL25h", zw3d ) ! total Chl 382 zw3d(:,:,:) = fabm3d_25h(:,:,:,9)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 383 CALL iom_put( "netPP25h", zw3d ) ! netPP 384 zw3d(:,:,:) = (1.7/fabm3d_25h(:,:,:,10))*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 385 CALL iom_put( "visib25h", zw3d ) ! light attenuation convert to visibility 386 zw3d(:,:,:) = fabm3d_25h(:,:,:,11)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 387 CALL iom_put( "PhytoC25h", zw3d ) ! total phytoplankton 388 #endif 321 389 322 390 ! Write velocities (instantaneous) … … 362 430 rmxln_25h(:,:,:) = mxln(:,:,:) 363 431 #endif 432 #if defined key_fabm 433 fabm3d_25h(:,:,:,1) = trn(:,:,:,jp_fabm_m1+jp_fabm_n1p) 434 fabm3d_25h(:,:,:,2) = trn(:,:,:,jp_fabm_m1+jp_fabm_n3n) 435 fabm3d_25h(:,:,:,3) = trn(:,:,:,jp_fabm_m1+jp_fabm_n4n) 436 fabm3d_25h(:,:,:,4) = trn(:,:,:,jp_fabm_m1+jp_fabm_n5s) 437 fabm3d_25h(:,:,:,5) = trn(:,:,:,jp_fabm_m1+jp_fabm_o2o) 438 fabm3d_25h(:,:,:,6)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3ph) 439 fabm3d_25h(:,:,:,7)= fabm_get_bulk_diagnostic_data(model, jp_fabm_o3pc) 440 fabm3d_25h(:,:,:,8)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_chltot) 441 fabm3d_25h(:,:,:,9)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_netpp) 442 fabm3d_25h(:,:,:,10)= fabm_get_bulk_diagnostic_data(model, jp_fabm_xeps) 443 fabm3d_25h(:,:,:,11)= fabm_get_bulk_diagnostic_data(model, jp_fabmdia_phytot) 444 #endif 364 445 cnt_25h = 1 365 446 IF (lwp) WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90
r7835 r8049 10 10 jp_fabm_surface, jp_fabm_bottom, & 11 11 jp_fabm_m1 12 13 INTEGER, PUBLIC :: jp_fabm_chl1, jp_fabm_chl2, & 14 jp_fabm_chl3, jp_fabm_chl4, & 15 jp_fabm_p1c, jp_fabm_p1n, & 16 jp_fabm_p1p, jp_fabm_p1s, & 17 jp_fabm_p2c, jp_fabm_p2n, & 18 jp_fabm_p2p, jp_fabm_p3c, & 19 jp_fabm_p3n, jp_fabm_p3p, & 20 jp_fabm_p4c, jp_fabm_p4n, & 21 jp_fabm_p4p, jp_fabm_z4c, & 22 jp_fabm_z5c, jp_fabm_z5n, & 23 jp_fabm_z5p, jp_fabm_z6c, & 24 jp_fabm_z6n, jp_fabm_z6p, & 25 jp_fabm_n1p, jp_fabm_n3n, & 26 jp_fabm_n4n, jp_fabm_n5s, & 27 jp_fabm_o2o, jp_fabm_netp1, & 28 jp_fabm_netp2,jp_fabm_netp3, & 29 jp_fabm_netp4,jp_fabm_o3ph, & 30 jp_fabm_o3pc, jp_fabm_xeps 31 32 INTEGER, PUBLIC :: jp_fabmdia_3dout = 12 33 34 INTEGER, PUBLIC :: jp_fabmdia_chltot, jp_fabmdia_netpp, jp_fabmdia_phytot 12 35 13 36 #if defined key_fabm -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90
r7835 r8049 68 68 jpdia3d = jpdia3d + size(model%diagnostic_variables) 69 69 jpdiabio = jpdiabio + jp_fabm 70 70 71 71 !Initialize input data structures. 72 72 call initialize_inputs 73 74 IF(lwp) WRITE(numout,*) 'DAF: jp_fabm, jp_fabm0, jp_fabm1, jp_fabm_m1, jptra = ', jp_fabm, jp_fabm0, jp_fabm1, jp_fabm_m1, jptra 75 76 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 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_netp1= fabm_diag_index( 'P1_netP' ) 107 !jp_fabm_netp2= fabm_diag_index( 'P2_netP' ) 108 !jp_fabm_netp3= fabm_diag_index( 'P3_netP' ) 109 !jp_fabm_netp4= fabm_diag_index( 'P4_netP' ) 110 !jp_fabm_o3ph = fabm_diag_index( 'ph_reported_on_total_scale' ) 111 !jp_fabm_o3pc = fabm_diag_index( 'mole_concentration_of_carbonate_expressed_as_carbon') 112 jp_fabm_o3ph = fabm_diag_index( 'O3_pH' ) 113 jp_fabm_o3pc = fabm_diag_index( 'O3_pCO2') 114 jp_fabmdia_chltot = fabm_diag_index( 'total_chlorophyll_calculator_result' ) 115 jp_fabmdia_netpp = fabm_diag_index( 'net_primary_production_result' ) 116 jp_fabm_xeps = fabm_diag_index( 'light_xEPS' ) 117 jp_fabmdia_phytot = fabm_diag_index( 'total_phytoplankton_result' ) 118 119 IF(lwp) WRITE(numout,*) 'DAF: jp_fabm_n5s = ', jp_fabm_n5s 120 121 !jp_fabmdia_chltot = fabm_diag_index( 'total_chlorophyll' ) 122 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 73 123 74 124 IF (lwp) THEN … … 190 240 WRITE (missing_value,'(E9.3)') -2.E20 191 241 WRITE (string_dimensions,'(I1)') number_dimensions 192 SELECT CASE (number_dimensions) 193 CASE (3) 194 DO i=1,size(trd_tags) 195 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'// & 196 & TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 197 END DO 198 CASE (-1) 199 DO i=1,size(trd_tags) 200 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'// & 201 & TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" />' 202 END DO 203 CASE default 204 IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise trends of variable '//TRIM(variable%name)//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional trends not supported!!!' 205 END SELECT 242 !SELECT CASE (number_dimensions) 243 !CASE (3) 244 ! DO i=1,size(trd_tags) 245 ! WRITE (xml_unit,'(A)') ' <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 246 ! END DO 247 !CASE (-1) 248 ! DO i=1,size(trd_tags) 249 ! WRITE (xml_unit,'(A)') ' <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" />' 250 ! END DO 251 !CASE default 252 ! IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise trends of variable '//TRIM(variable%name)//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional trends not supported!!!' 253 !END SELECT 206 254 207 255 END SUBROUTINE write_trends_xml … … 294 342 END SUBROUTINE trc_ini_fabm 295 343 344 INTEGER FUNCTION fabm_state_index( state_name ) 345 !!---------------------------------------------------------------------- 346 !! *** fabm_state_index *** 347 !! 348 !! ** Purpose : return index of a given FABM state variable 349 !! 350 !! ** Method : - loop through state variables until found 351 !!---------------------------------------------------------------------- 352 353 IMPLICIT NONE 354 355 CHARACTER(LEN=256), INTENT(IN) :: state_name 356 357 INTEGER :: jn 358 359 !!---------------------------------------------------------------------- 360 361 fabm_state_index = -1 362 !WRITE(numout,*) 'PETE - STATE VARIABLES' 363 DO jn=1,jp_fabm 364 !WRITE(numout,*) TRIM(model%state_variables(jn)%name) 365 IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 366 fabm_state_index = jn 367 EXIT 368 ENDIF 369 END DO 370 IF (fabm_state_index == -1) THEN 371 CALL ctl_stop( 'Could not find '//TRIM(state_name)//' state variable' ) 372 ELSE 373 IF (lwp) WRITE(numout,*) 'DAF: Index for '//TRIM(state_name)//' is: ', fabm_state_index 374 ENDIF 375 376 END FUNCTION fabm_state_index 377 378 INTEGER FUNCTION fabm_diag_index( diag_name ) 379 !!---------------------------------------------------------------------- 380 !! *** fabm_state_index *** 381 !! 382 !! ** Purpose : return index of a given FABM diagnostic variable 383 !! 384 !! ** Method : - loop through diagnostic variables until found 385 !!---------------------------------------------------------------------- 386 387 IMPLICIT NONE 388 389 CHARACTER(LEN=256), INTENT(IN) :: diag_name 390 391 INTEGER :: jn 392 393 !!---------------------------------------------------------------------- 394 395 fabm_diag_index = -1 396 !WRITE(numout,*) 'PETE - DIAG VARIABLES' 397 DO jn = 1, SIZE(model%diagnostic_variables) 398 !WRITE(numout,*) TRIM(model%diagnostic_variables(jn)%name) 399 !WRITE(numout,*) TRIM(model%diagnostic_variables(jn)%standard_variable%name) 400 IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 401 fabm_diag_index = jn 402 EXIT 403 ENDIF 404 END DO 405 IF (fabm_diag_index == -1) THEN 406 CALL ctl_stop( 'Could not find '//TRIM(diag_name)//' diagnostic' ) 407 ELSE 408 IF (lwp) WRITE(numout,*) 'DAF: Index for '//TRIM(diag_name)//' is: ', fabm_diag_index 409 ENDIF 410 411 END FUNCTION fabm_diag_index 412 296 413 #else 297 414 !!---------------------------------------------------------------------- -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r6332 r8049 54 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 55 55 CHARACTER (len=22) :: charout 56 ! +++>>> FABM 57 INTEGER :: jn 58 ! FABM <<<+++ 56 59 !!---------------------------------------------------------------------- 57 60 ! … … 68 71 IF( lk_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' ) ! PISCES model 69 72 IF( lk_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1 ) ! MY_TRC model 70 73 ! +++>>> FABM 74 IF( lk_fabm ) THEN 75 DO jn=1,jp_fabm ! state variable loop 76 IF (lk_rad_fabm(jn)) THEN 77 CALL trc_rad_sms( kt, trb, trn, jn+jp_fabm_m1 , jn+jp_fabm_m1 ) 78 ENDIF 79 END DO 80 END IF 81 ! FABM <<<+++ 71 82 ! 72 83 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
r6331 r8049 22 22 CHARACTER(len=50) :: cn_trdrst_trc_in !: suffix of pass. tracer restart name (input) 23 23 CHARACTER(len=50) :: cn_trdrst_trc_out !: suffix of pass. tracer restart name (output) 24 LOGICAL, DIMENSION(jptra) :: ln_trdtrc !: large trends diagnostic to write or not (namelist) 24 ! --->>> FABM 25 ! LOGICAL, DIMENSION(jptra) :: ln_trdtrc !: large trends diagnostic to write or not (namelist) 26 ! FABM <<<--- 27 ! +++>>> FABM 28 LOGICAL, DIMENSION(jpmaxtrc) :: ln_trdtrc !: large trends diagnostic to write or not (namelist) 29 ! FABM <<<+++ 25 30 26 31 # if defined key_trdtrc && defined key_iomput -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r6331 r8049 15 15 USE par_cfc ! CFC 11 and 12 tracers 16 16 USE par_my_trc ! user defined passive tracers 17 ! +++>>> FABM 18 USE par_fabm ! FABM 19 ! FABM <<<+++ 17 20 18 21 IMPLICIT NONE … … 24 27 ! Passive tracers : Total size 25 28 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 26 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc 27 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d 28 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d 29 ! --->>> FABM 30 ! INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc 31 ! INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d 32 ! INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d 33 ! FABM <<<--- 34 ! +++>>> FABM 35 INTEGER, PUBLIC :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc 36 INTEGER, PUBLIC :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d 37 INTEGER, PUBLIC :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d 38 ! FABM <<<+++ 29 39 ! ! total number of sms diagnostic arrays 30 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 40 ! --->>> FABM 41 ! INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 42 ! FABM <<<--- 43 ! +++>>> FABM 44 INTEGER, PUBLIC :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 45 ! FABM <<<+++ 31 46 32 47 ! 1D configuration ("key_c1d") -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trc.F90
r6332 r8049 83 83 END TYPE 84 84 85 REAL(wp), DIMENSION(jptra), PUBLIC :: trc_ice_ratio, & ! ice-ocean tracer ratio 85 ! --->>> FABM 86 !REAL(wp), DIMENSION(jptra), PUBLIC :: trc_ice_ratio, & ! ice-ocean tracer ratio 87 ! trc_ice_prescr ! prescribed ice trc cc 88 !CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 89 ! FABM <<<--- 90 ! +++>>> FABM 91 REAL(wp), DIMENSION(jpmaxtrc), PUBLIC :: trc_ice_ratio, & ! ice-ocean tracer ratio 86 92 trc_ice_prescr ! prescribed ice trc cc 87 CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 93 CHARACTER(len=2), DIMENSION(jpmaxtrc), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 94 ! FABM <<<+++ 88 95 89 96 !! information for outputs … … 93 100 CHARACTER(len = 80) :: cllname !: long name 94 101 CHARACTER(len = 20) :: clunit !: unit 95 LOGICAL :: llinit !: read in a file or not 96 #if defined key_my_trc 97 LOGICAL :: llsbc !: read in a file or not 98 LOGICAL :: llcbc !: read in a file or not 99 LOGICAL :: llobc !: read in a file or not 100 #endif 101 LOGICAL :: llsave !: save the tracer or not 102 ! --->>> FABM 103 ! LOGICAL :: llinit !: read in a file or not 104 !!#if defined key_my_trc 105 ! LOGICAL :: llsbc !: read in a file or not 106 ! LOGICAL :: llcbc !: read in a file or not 107 ! LOGICAL :: llobc !: read in a file or not 108 !#endif 109 ! LOGICAL :: llsave !: save the tracer or not 110 ! FABM <<<--- 111 ! +++ FABM 112 LOGICAL :: llinit=.FALSE. !: read in a file or not 113 #if defined key_fabm 114 LOGICAL :: llsbc=.FALSE. !: read in a file or not 115 LOGICAL :: llcbc=.FALSE. !: read in a file or not 116 LOGICAL :: llobc=.FALSE. !: read in a file or not 117 #endif 118 LOGICAL :: llsave=.FALSE. !: save the tracer or not 119 ! FABM <<<+++ 102 120 END TYPE PTRACER 103 121 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcnm !: tracer name … … 228 246 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , & 229 247 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 230 #if defined key_my_trc 248 ! --->>> FABM 249 !!#if defined key_my_trc 250 ! FABM <<<--- 251 ! +++>>> FABM 252 #if defined key_fabm 253 ! FABM <<<+++ 231 254 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & 232 255 #endif -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r6332 r8049 7 7 !! 3.6 ! 2015-03 (T . Lovato) Revision and BDY support 8 8 !!---------------------------------------------------------------------- 9 #if defined key_top9 #if defined key_top 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_top' TOP model … … 29 29 PUBLIC trc_bc_read ! called in trcstp.F90 or within 30 30 31 INTEGER , SAVE, PUBLIC :: nb_trcobc ! number of tracers with open BC32 INTEGER , SAVE, PUBLIC :: nb_trcsbc ! number of tracers with surface BC33 INTEGER , SAVE, PUBLIC :: nb_trccbc ! number of tracers with coastal BC31 INTEGER , SAVE, PUBLIC :: nb_trcobc ! number of tracers with open BC 32 INTEGER , SAVE, PUBLIC :: nb_trcsbc ! number of tracers with surface BC 33 INTEGER , SAVE, PUBLIC :: nb_trccbc ! number of tracers with coastal BC 34 34 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indobc ! index of tracer with OBC data 35 35 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indsbc ! index of tracer with SBC data 36 36 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indcbc ! index of tracer with CBC data 37 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trsfac ! multiplicative factor for SBC tracer values38 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcsbc ! structure of data input SBC (file informations, fields read)39 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trcfac ! multiplicative factor for CBC tracer values40 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trccbc ! structure of data input CBC (file informations, fields read)37 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trsfac ! multiplicative factor for SBC tracer values 38 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcsbc ! structure of data input SBC (file informations, fields read) 39 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trcfac ! multiplicative factor for CBC tracer values 40 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trccbc ! structure of data input CBC (file informations, fields read) 41 41 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: rf_trofac ! multiplicative factor for OBCtracer values 42 42 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: sf_trcobc ! structure of data input OBC (file informations, fields read) … … 65 65 INTEGER :: jl, jn , ib, ibd, ii, ij, ik ! dummy loop indices 66 66 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 67 INTEGER :: ios! Local integer output status for namelist read67 INTEGER :: ios ! Local integer output status for namelist read 68 68 INTEGER :: nblen, igrd ! support arrays for BDY 69 69 CHARACTER(len=100) :: clndta, clntrc … … 130 130 DO ib = 1, nb_bdy 131 131 #endif 132 READ ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 )133 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp )134 IF(lwm) WRITE ( numont, namtrc_bc )132 READ ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 133 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 134 IF(lwm) WRITE ( numont, namtrc_bc ) 135 135 #if defined key_bdy 136 136 sn_trcobc(:,ib)=sn_trcobc2(:) … … 190 190 IF ( nb_trcsbc > 0 ) THEN 191 191 WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. ' 192 DO jn = 1, ntrc192 DO jn = 1, ntrc 193 193 IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 194 194 ENDDO 195 195 ENDIF 196 196 WRITE(numout,'(2a)') ' SURFACE BC data repository : ', TRIM(cn_dir_sbc) 197 197 … … 203 203 IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 204 204 ENDDO 205 205 ENDIF 206 206 WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc) 207 207 … … 227 227 WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp(ib),' days' 228 228 WRITE(numout,'(a,f10.2,a)') ' - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 229 ENDIF230 ENDDO231 ENDIF229 ENDIF 230 ENDDO 231 ENDIF 232 232 #endif 233 233 WRITE(numout,'(2a)') ' OPEN BC data repository : ', TRIM(cn_dir_obc) … … 243 243 ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 ) 244 244 IF( ierr1 > 0 ) THEN 245 CALL ctl_stop( 'trc_bc_init: unable to allocate 245 CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' ) ; RETURN 246 246 ENDIF 247 247 … … 249 249 250 250 DO ib = 1, nb_bdy 251 DO jn = 1, ntrc251 DO jn = 1, ntrc 252 252 253 253 nblen = idx_bdy(ib)%nblen(igrd) … … 255 255 IF ( ln_trc_obc(jn) ) THEN 256 256 ! Initialise from external data 257 jl = n_trc_indobc(jn)257 jl = n_trc_indobc(jn) 258 258 slf_i(jl) = sn_trcobc(jn,ib) 259 259 rf_trofac(jl,ib) = rn_trofac(jn) 260 260 ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk) , STAT=ierr2 ) 261 261 IF( sn_trcobc(jn,ib)%ln_tint ) ALLOCATE( sf_trcobc(jl,ib)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 262 IF( ierr2 + ierr3 > 0 ) THEN263 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' ) ; RETURN264 ENDIF262 IF( ierr2 + ierr3 > 0 ) THEN 263 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' ) ; RETURN 264 ENDIF 265 265 trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:) 266 266 trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib) … … 279 279 END DO 280 280 trcdta_bdy(jn,ib)%rn_fac = 1._wp 281 ENDIF282 ENDDO281 ENDIF 282 ENDDO 283 283 CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 284 284 ENDDO … … 371 371 IF ( PRESENT(jit) ) THEN 372 372 373 #ifdef key_bdy 373 374 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 374 IF( nb_trcobc > 0 ) THEN375 IF( nb_trcobc > 0 ) THEN 375 376 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 376 377 DO ib = 1,nb_bdy 377 378 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1) 378 379 ENDDO 379 ENDIF 380 381 ! SURFACE boundary conditions 382 IF( nb_trcsbc > 0 ) THEN 380 ENDIF 381 #endif 382 383 ! SURFACE boundary conditions 384 IF( nb_trcsbc > 0 ) THEN 383 385 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 384 386 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 385 ENDIF386 387 ! COASTAL boundary conditions388 IF( nb_trccbc > 0 ) THEN387 ENDIF 388 389 ! COASTAL boundary conditions 390 IF( nb_trccbc > 0 ) THEN 389 391 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 390 392 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 391 ENDIF393 ENDIF 392 394 393 395 ELSE 394 396 397 #ifdef key_bdy 395 398 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 396 399 IF( nb_trcobc > 0 ) THEN … … 400 403 ENDDO 401 404 ENDIF 405 #endif 402 406 403 407 ! SURFACE boundary conditions -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90
r6332 r8049 34 34 !!---------------------------------------------------------------------- 35 35 !! NEMO/OPA 3.6 , NEMO Consortium (2015) 36 !! $Id$ 36 !! $Id$ 37 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 38 !!---------------------------------------------------------------------- … … 167 167 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 168 168 !! 169 REAL(wp) :: z wgt! boundary weight169 REAL(wp) :: zcoef, zcoef1, zcoef2 ! boundary weight 170 170 INTEGER :: ib, ik, igrd ! dummy loop indices 171 INTEGER :: ii, ij, zcoef, zcoef1, zcoef2,ip, jp ! 2D addresses171 INTEGER :: ii, ij, ip, jp ! 2D addresses 172 172 !!---------------------------------------------------------------------- 173 173 ! … … 180 180 DO ik = 1, jpkm1 181 181 ! search the sense of the gradient 182 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij)183 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1)184 IF ( zcoef1+zcoef2== 0) THEN182 zcoef1 = bdytmask(ii-1,ij )*tmask(ii-1,ij,ik) + bdytmask(ii+1,ij )*tmask(ii+1,ij,ik) 183 zcoef2 = bdytmask(ii ,ij-1)*tmask(ii,ij-1,ik) + bdytmask(ii ,ij+1)*tmask(ii,ij+1,ik) 184 IF ( nint(zcoef1+zcoef2) == 0) THEN 185 185 ! corner 186 186 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik) 187 tra(ii,ij,ik,jn) = tra(ii-1,ij ,ik,jn) * tmask(ii-1,ij ,ik) + & 188 & tra(ii+1,ij ,ik,jn) * tmask(ii+1,ij ,ik) + & 189 & tra(ii ,ij-1,ik,jn) * tmask(ii ,ij-1,ik) + & 190 & tra(ii ,ij+1,ik,jn) * tmask(ii ,ij+1,ik) 191 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 187 IF (zcoef > .5_wp) THEN ! Only set not isolated points. 188 tra(ii,ij,ik,jn) = tra(ii-1,ij ,ik,jn) * tmask(ii-1,ij ,ik) + & 189 & tra(ii+1,ij ,ik,jn) * tmask(ii+1,ij ,ik) + & 190 & tra(ii ,ij-1,ik,jn) * tmask(ii ,ij-1,ik) + & 191 & tra(ii ,ij+1,ik,jn) * tmask(ii ,ij+1,ik) 192 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / zcoef ) * tmask(ii,ij,ik) 193 ENDIF 194 ELSEIF ( nint(zcoef1+zcoef2) == 2) THEN 195 ! oblique corner 196 zcoef = tmask(ii-1,ij,ik)*bdytmask(ii-1,ij ) + tmask(ii+1,ij,ik)*bdytmask(ii+1,ij ) + & 197 & tmask(ii,ij-1,ik)*bdytmask(ii,ij -1 ) + tmask(ii,ij+1,ik)*bdytmask(ii,ij+1 ) 198 tra(ii,ij,ik,jn) = tra(ii-1,ij ,ik,jn) * tmask(ii-1,ij ,ik)*bdytmask(ii-1,ij ) + & 199 & tra(ii+1,ij ,ik,jn) * tmask(ii+1,ij ,ik)*bdytmask(ii+1,ij ) + & 200 & tra(ii ,ij-1,ik,jn) * tmask(ii ,ij-1,ik)*bdytmask(ii,ij -1 ) + & 201 & tra(ii ,ij+1,ik,jn) * tmask(ii ,ij+1,ik)*bdytmask(ii,ij+1 ) 202 203 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX(1._wp, zcoef) ) * tmask(ii,ij,ik) 192 204 ELSE 193 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij)194 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1)195 tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) 205 ip = nint(bdytmask(ii+1,ij )*tmask(ii+1,ij,ik) - bdytmask(ii-1,ij )*tmask(ii-1,ij,ik)) 206 jp = nint(bdytmask(ii ,ij+1)*tmask(ii,ij+1,ik) - bdytmask(ii ,ij-1)*tmask(ii,ij-1,ik)) 207 tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 196 208 ENDIF 197 209 END DO -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r6332 r8049 24 24 USE trcini_c14b ! C14 bomb initialisation 25 25 USE trcini_my_trc ! MY_TRC initialisation 26 ! +++>>> FABM 27 USE trcsms_fabm ! FABM initialisation 28 USE trcini_fabm ! FABM initialisation 29 ! FABM <<<FABM 26 30 USE trcdta ! initialisation from files 27 31 USE daymod ! calendar manager … … 70 74 IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 71 75 IF(lwp) WRITE(numout,*) '~~~~~~~' 76 ! +++>>> FABM 77 ! Allow FABM to update numbers of biogeochemical tracers, diagnostics (jptra etc.) 78 IF( lk_fabm ) CALL nemo_fabm_init 79 ! FABM <<<+++ 72 80 73 81 CALL top_alloc() ! allocate TOP arrays … … 102 110 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 103 111 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 112 ! +++>>> FABM 113 IF( lk_fabm ) CALL trc_ini_fabm ! FABM tracers 114 ! FABM <<<+++ 104 115 105 116 CALL trc_ice_ini ! Tracers in sea ice … … 141 152 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 142 153 ENDIF 143 ! slwa temporary insert initialise tracer 144 trn(:,:,:,:) = 0._wp 145 if(nproc.eq.39)then 146 DO jn = 1, jptra 147 trn(:,:,:,jn) = 100._wp * tmask(:,:,:) 148 ENDDO 149 endif 150 !!!! slwa temp 151 ! 152 trb(:,:,:,:) = trn(:,:,:,:) 153 ! 154 ENDIF 154 ENDIF 155 ! --->>> FABM 155 156 ! Initialisation of tracers Boundary Conditions - here so that you can use initial condition as boundary 156 IF( lk_my_trc ) CALL trc_bc_init(jptra) 157 !IF( lk_my_trc ) CALL trc_bc_init(jptra) 158 ! FABM <<<--- 159 ! FABM +++>>> 160 ! Initialisation of FABM diagnostics and tracer boundary conditions (so that you can use initial condition as boundary) 161 IF( lk_fabm ) THEN 162 wndm=0._wp !uninitiased field at this point 163 qsr=0._wp !uninitiased field at this point 164 CALL compute_fabm ! only needed to set-up diagnostics 165 CALL trc_bc_init(jptra) 166 ENDIF 167 ! FABM <<<+++ 157 168 158 169 tra(:,:,:,:) = 0._wp … … 168 179 169 180 trai(:) = 0._wp ! initial content of all tracers 170 DO jn = 1, jptra171 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )172 END DO181 !DO jn = 1, jptra 182 ! trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 183 !END DO 173 184 174 185 IF(lwp) THEN ! control print … … 179 190 WRITE(numout,*) ' *** Total inital content of all tracers ' 180 191 WRITE(numout,*) 181 DO jn = 1, jptra182 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)183 ENDDO192 !DO jn = 1, jptra 193 ! WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 194 !ENDDO 184 195 WRITE(numout,*) 185 196 ENDIF -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r6332 r8049 25 25 USE trcnam_c14b ! C14 SMS namelist 26 26 USE trcnam_my_trc ! MY_TRC SMS namelist 27 ! +++>>> FABM 28 USE trcnam_fabm ! FABM SMS namelist 29 ! FABM <<<+++ 27 30 USE trd_oce 28 31 USE trdtrc_oce … … 178 181 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 179 182 ENDIF 183 184 ! +++>>> FABM 185 IF( lk_fabm ) THEN ; CALL trc_nam_fabm ! FABM tracers 186 ELSE ; IF(lwp) WRITE(numout,*) ' FABM not used' 187 ENDIF 188 ! FABM <<<+++ 180 189 ! 181 190 END SUBROUTINE trc_nam … … 197 206 198 207 199 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'208 IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 200 209 IF(lwp) WRITE(numout,*) '~~~~~~~' 201 210 … … 244 253 245 254 ! --- Namelist declarations --- ! 246 TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 255 ! --->>> FABM 256 !TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 257 ! FABM <<<--- 258 ! +++>>> FABM 259 TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer 260 ! FABM <<<+++ 247 261 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 248 262 … … 288 302 !! 289 303 !!--------------------------------------------------------------------- 290 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 291 !! 292 NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 304 ! --->>> FABM 305 !TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 306 ! FABM <<<--- 307 ! +++>>> FABM 308 TYPE(PTRACER), DIMENSION(jpmaxtrc) :: sn_tracer ! type of tracer for saving if not key_iomput 309 ! FABM <<<+++ 310 !! 311 NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 293 312 294 313 INTEGER :: ios ! Local integer output status for namelist read … … 296 315 !!--------------------------------------------------------------------- 297 316 IF(lwp) WRITE(numout,*) 298 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'317 IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 299 318 IF(lwp) WRITE(numout,*) '~~~~~~~' 300 319 320 ! Initialise logical flags to .FALSE.: 321 sn_tracer(:)%llinit = .FALSE. 322 sn_tracer(:)%llsave = .FALSE. 323 #ifdef key_fabm 324 sn_tracer(:)%llsbc = .FALSE. 325 sn_tracer(:)%llcbc = .FALSE. 326 sn_tracer(:)%llcbc = .FALSE. 327 #endif 301 328 302 329 REWIND( numnat_ref ) ! Namelist namtrc in reference namelist : Passive tracer variables … … 314 341 ctrcun (jn) = TRIM( sn_tracer(jn)%clunit ) 315 342 ln_trc_ini(jn) = sn_tracer(jn)%llinit 316 #if defined key_my_trc 343 ! --->>> FABM 344 !!#if defined key_my_trc 345 ! FABM <<<--- 346 ! +++>>> FABM 347 #if defined key_fabm 348 ! FABM <<<+++ 317 349 ln_trc_sbc(jn) = sn_tracer(jn)%llsbc 318 350 ln_trc_cbc(jn) = sn_tracer(jn)%llcbc … … 321 353 ln_trc_wri(jn) = sn_tracer(jn)%llsave 322 354 END DO 323 355 356 ! +++>>> FABM 357 if (lk_fabm) CALL trc_nam_fabm_override 358 ! FABM <<<+++ 324 359 END SUBROUTINE trc_nam_trc 325 360 -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r6331 r8049 28 28 USE iom 29 29 USE daymod 30 ! +++>>> FABM 31 USE trcrst_fabm 32 ! FABM <<<+++ 30 33 IMPLICIT NONE 31 34 PRIVATE … … 117 120 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 118 121 END DO 122 ! +++>>> FABM 123 124 IF (lk_fabm) CALL trc_rst_read_fabm 125 ! FABM <<<+++ 119 126 ! 120 127 END SUBROUTINE trc_rst_read … … 142 149 CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 143 150 END DO 151 ! +++>>> FABM 152 IF (lk_fabm) CALL trc_rst_wri_fabm(kt) 153 ! FABM <<<+++ 144 154 ! 145 155 IF( kt == nitrst ) THEN -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r6331 r8049 19 19 USE trcsms_c14b ! C14b tracer 20 20 USE trcsms_my_trc ! MY_TRC tracers 21 ! +++>>>> FABM 22 USE trcsms_fabm ! FABM tracers 23 ! FABM <<<+++ 21 24 USE prtctl_trc ! Print control for debbuging 22 25 … … 52 55 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C14 53 56 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 57 ! +++>>> FABM 58 IF( lk_fabm ) CALL trc_sms_fabm ( kt ) ! FABM tracers 59 ! FABM <<<+++ 54 60 55 61 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r6332 r8049 110 110 ! 111 111 ztrai = 0._wp ! content of all tracers 112 DO jn = 1, jptra113 ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )114 END DO115 IF( lwp ) WRITE(numstr,9300) kt, ztrai / areatot112 !DO jn = 1, jptra 113 ! ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 114 !END DO 115 !IF( lwp ) WRITE(numstr,9300) kt, ztrai / areatot 116 116 9300 FORMAT(i10,e18.10) 117 117 ! -
branches/UKMO/CO6_KD490_amm7_oper_fabm/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r6332 r8049 21 21 USE trcwri_c14b 22 22 USE trcwri_my_trc 23 ! +++>>> FABM 24 USE trcwri_fabm 25 ! FABM <<<+++ 23 26 24 27 IMPLICIT NONE … … 72 75 IF( lk_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 73 76 #endif 77 ! +++>>>FABM 78 IF( lk_fabm ) CALL trc_wri_fabm ! FABM tracers 79 ! FABM <<<+++ 74 80 ! 75 81 IF( nn_timing == 1 ) CALL timing_stop('trc_wri')
Note: See TracChangeset
for help on using the changeset viewer.