- Timestamp:
- 2018-10-29T15:55:40+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 38 edited
- 2 copied
-
FABM (copied) (copied from branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/TOP_SRC/FABM)
-
MY_TRC/trcsms_my_trc.F90 (modified) (2 diffs)
-
MY_TRC/trcwri_my_trc.F90 (modified) (3 diffs)
-
PISCES/P2Z/p2zbio.F90 (modified) (1 diff)
-
PISCES/P2Z/p2zsms.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zbio.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zche.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zflx.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zint.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zlim.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zlys.F90 (modified) (2 diffs)
-
PISCES/P4Z/p4zmeso.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zmicro.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zmort.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zopt.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zprod.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zsbc.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zsed.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zsink.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zsms.F90 (modified) (4 diffs)
-
PISCES/trcice_pisces.F90 (modified) (6 diffs)
-
TRP/trcldf.F90 (modified) (2 diffs)
-
TRP/trcnxt.F90 (modified) (5 diffs)
-
TRP/trcrad.F90 (modified) (8 diffs)
-
TRP/trcsbc.F90 (modified) (1 diff)
-
TRP/trctrp.F90 (modified) (2 diffs)
-
TRP/trdtrc.F90 (modified) (1 diff)
-
TRP/trdtrc_oce.F90 (modified) (1 diff)
-
par_trc.F90 (modified) (2 diffs)
-
trc.F90 (modified) (5 diffs)
-
trcbc.F90 (modified) (12 diffs)
-
trcbdy.F90 (copied) (copied from branches/UKMO/AMM15_v3_6_STABLE_package/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90)
-
trcdta.F90 (modified) (8 diffs)
-
trcini.F90 (modified) (6 diffs)
-
trcnam.F90 (modified) (11 diffs)
-
trcrst.F90 (modified) (3 diffs)
-
trcsms.F90 (modified) (3 diffs)
-
trcstp.F90 (modified) (5 diffs)
-
trcsub.F90 (modified) (1 diff)
-
trcwri.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90
r10251 r10253 18 18 USE trd_oce 19 19 USE trdtrc 20 USE trcbc, only : trc_bc_read 20 21 21 22 IMPLICIT NONE … … 55 56 56 57 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 58 59 CALL trc_bc_read ( kt ) ! tracers: surface and lateral Boundary Conditions 57 60 58 61 IF( l_trdtrc ) THEN ! Save the trends in the ixed layer -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r10251 r10253 19 19 20 20 PUBLIC trc_wri_my_trc 21 #if defined key_tracer_budget 22 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE :: trb_temp ! slwa 23 #endif 24 21 25 22 26 # include "top_substitute.h90" 23 27 CONTAINS 24 28 29 #if defined key_tracer_budget 30 SUBROUTINE trc_wri_my_trc (kt, fl) ! slwa 31 #else 25 32 SUBROUTINE trc_wri_my_trc 33 #endif 26 34 !!--------------------------------------------------------------------- 27 35 !! *** ROUTINE trc_wri_trc *** … … 29 37 !! ** Purpose : output passive tracers fields 30 38 !!--------------------------------------------------------------------- 39 #if defined key_tracer_budget 40 INTEGER, INTENT( in ), OPTIONAL :: fl 41 INTEGER, INTENT( in ) :: kt 42 REAL(wp), DIMENSION(jpi,jpj,jpk) :: trpool !tracer pool temporary output 43 #else 44 INTEGER, INTENT( in ) :: kt 45 #endif 31 46 CHARACTER (len=20) :: cltra 32 INTEGER :: jn 47 INTEGER :: jn,jk ! JC TODO jk defined here but may not be used 33 48 !!--------------------------------------------------------------------- 34 49 35 50 ! write the tracer concentrations in the file 36 51 ! --------------------------------------- 52 53 54 #if defined key_tracer_budget 55 IF( PRESENT(fl)) THEN 56 ! depth integrated 57 ! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt 58 DO jn = jp_myt0, jp_myt1 59 IF(ln_trdtrc (jn))THEN 60 trpool(:,:,:) = 0.5 * ( trn(:,:,:,jn) * fse3t_a(:,:,:) + & 61 trb_temp(:,:,:,jn) * fse3t(:,:,:) ) 62 cltra = TRIM( ctrcnm(jn) )//"e3t" ! depth integrated output 63 IF( kt == nittrc000 ) write(6,*)'output pool ',cltra 64 DO jk = 1, jpk 65 trpool(:,:,jk) = trpool(:,:,jk) 66 END DO 67 CALL iom_put( cltra, trpool) 68 69 END IF 70 END DO 71 72 ELSE 73 74 IF( kt == nittrc000 ) THEN 75 ALLOCATE(trb_temp(jpi,jpj,jpk,jp_my_trc)) ! slwa 76 ENDIF 77 trb_temp(:,:,:,:)=trn(:,:,:,:) ! slwa save for tracer budget (unfiltered trn) 78 79 80 END IF 81 #else 37 82 DO jn = jp_myt0, jp_myt1 38 83 cltra = TRIM( ctrcnm(jn) ) ! short title for tracer 39 84 CALL iom_put( cltra, trn(:,:,:,jn) ) 40 85 END DO 86 #endif 41 87 ! 42 88 END SUBROUTINE trc_wri_my_trc … … 48 94 PUBLIC trc_wri_my_trc 49 95 CONTAINS 50 SUBROUTINE trc_wri_my_trc ! Empty routine 96 #if defined key_tracer_budget 97 SUBROUTINE trc_wri_my_trc (kt, fl) ! slwa 98 INTEGER, INTENT( in ), OPTIONAL :: fl 99 INTEGER, INTENT( in ) :: kt 100 #else 101 ! JC TODO Subroutine arguments (kt) inconsistent with earlier definition 102 SUBROUTINE trc_wri_my_trc (kt) 103 INTEGER, INTENT( in ) :: kt 104 #endif 51 105 END SUBROUTINE trc_wri_my_trc 52 106 #endif -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r10251 r10253 599 599 600 600 !!====================================================================== 601 END MODULE 601 END MODULE p2zbio -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
r10251 r10253 84 84 85 85 !!====================================================================== 86 END MODULE 86 END MODULE p2zsms -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r10251 r10253 109 109 110 110 !!====================================================================== 111 END MODULE p4zbio 112 111 END MODULE p4zbio -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r10251 r10253 396 396 397 397 !!====================================================================== 398 END MODULE 398 END MODULE p4zche -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r10251 r10253 400 400 401 401 !!====================================================================== 402 END MODULE 402 END MODULE p4zflx -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
r10251 r10253 81 81 82 82 !!====================================================================== 83 END MODULE 83 END MODULE p4zint -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r10251 r10253 265 265 266 266 !!====================================================================== 267 END MODULE 267 END MODULE p4zlim -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r10251 r10253 152 152 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 153 153 ELSE 154 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 155 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 156 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 154 IF( ln_diatrc ) THEN 155 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 156 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 157 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 158 ENDIF 157 159 ENDIF 158 160 ! … … 223 225 #endif 224 226 !!====================================================================== 225 END MODULE 227 END MODULE p4zlys -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r10251 r10253 340 340 341 341 !!====================================================================== 342 END MODULE 342 END MODULE p4zmeso -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r10251 r10253 273 273 274 274 !!====================================================================== 275 END MODULE 275 END MODULE p4zmicro -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r10251 r10253 277 277 278 278 !!====================================================================== 279 END MODULE 279 END MODULE p4zmort -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r10251 r10253 439 439 440 440 !!====================================================================== 441 END MODULE 441 END MODULE p4zopt -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r10251 r10253 629 629 630 630 !!====================================================================== 631 END MODULE 631 END MODULE p4zprod -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r10251 r10253 519 519 520 520 !!====================================================================== 521 END MODULE 521 END MODULE p4zsbc -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r10251 r10253 436 436 437 437 !!====================================================================== 438 END MODULE 438 END MODULE p4zsed -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r10251 r10253 913 913 914 914 !!====================================================================== 915 END MODULE 915 END MODULE p4zsink -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90
r10251 r10253 38 38 39 39 REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget 40 REAL(wp) :: xfact1, xfact2 40 REAL(wp) :: xfact1, xfact2, xfact3 41 41 INTEGER :: numco2, numnut, numnit !: logical unit for co2 budget 42 42 … … 474 474 !!--------------------------------------------------------------------- 475 475 ! 476 INTEGER , INTENT( in ) :: kt ! ocean time-step index 477 REAL(wp) :: zfact 478 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 476 INTEGER, INTENT( in ) :: kt ! ocean time-step index 477 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 479 478 CHARACTER(LEN=100) :: cltxt 480 479 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol … … 492 491 xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr 493 492 xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr 493 xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s 494 494 cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron' 495 495 IF( lwp ) WRITE(numnut,*) TRIM(cltxt) … … 574 574 IF( iom_use( "Sdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 575 575 zsdenittot = glob_sum ( sdenit(:,:) * e1e2t(:,:) ) 576 CALL iom_put( "Sdenit", sdenit(:,:) * zfact* tmask(:,:,1) ) ! Nitrate reduction in the sediments576 CALL iom_put( "Sdenit", sdenit(:,:) * xfact3 * tmask(:,:,1) ) ! Nitrate reduction in the sediments 577 577 ENDIF 578 578 -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90
r10251 r10253 29 29 CONTAINS 30 30 31 31 32 SUBROUTINE trc_ice_ini_pisces 32 33 !!---------------------------------------------------------------------- 33 !! *** ROUTINE trc_ice_ini_pisces *** 34 !! *** ROUTINE trc_ini_pisces *** 35 !! 36 !! ** Purpose : Initialisation of the PISCES biochemical model 37 !!---------------------------------------------------------------------- 38 39 IF( lk_p4z ) THEN ; CALL p4z_ice_ini ! PISCES 40 ELSE ; CALL p2z_ice_ini ! LOBSTER 41 ENDIF 42 43 END SUBROUTINE trc_ice_ini_pisces 44 45 46 SUBROUTINE p4z_ice_ini 47 48 #if defined key_pisces 49 !!---------------------------------------------------------------------- 50 !! *** ROUTINE p4z_ice_ini *** 34 51 !! 35 52 !! ** Purpose : PISCES fake sea ice model setting … … 58 75 59 76 !--- Dummy variables 60 REAL(wp), DIMENSION(jptra,2) & 61 :: zratio ! effective ice-ocean tracer cc ratio 77 REAL(wp), DIMENSION(jp_pisces,2) :: zratio ! effective ice-ocean tracer cc ratio 78 REAL(wp), DIMENSION(jp_pisces,4) :: zpisc ! prescribes concentration 79 ! ! 1:global, 2:Arctic, 3:Antarctic, 4:Baltic 80 62 81 REAL(wp), DIMENSION(2) :: zrs ! ice-ocean salinity ratio, 1 - global, 2- Baltic 63 82 REAL(wp) :: zsice_bal ! prescribed ice salinity in the Baltic … … 80 99 ! fluxes 81 100 82 !--- Global case83 IF ( cn_trc_o(jpdic) == 'GL ' ) trc_o(:,:,jpdic) = 1.99e-3_wp84 IF ( cn_trc_o(jpdoc) == 'GL ' ) trc_o(:,:,jpdoc) = 2.04e-5_wp85 IF ( cn_trc_o(jptal) == 'GL ' ) trc_o(:,:,jptal) = 2.31e-3_wp86 IF ( cn_trc_o(jpoxy) == 'GL ' ) trc_o(:,:,jpoxy) = 2.47e-4_wp87 IF ( cn_trc_o(jpcal) == 'GL ' ) trc_o(:,:,jpcal) = 1.04e-8_wp88 IF ( cn_trc_o(jppo4) == 'GL ' ) trc_o(:,:,jppo4) = 5.77e-7_wp / po4r89 IF ( cn_trc_o(jppoc) == 'GL ' ) trc_o(:,:,jppoc) = 1.27e-6_wp101 !--- Global values 102 zpisc(jpdic,1) = 1.99e-3_wp 103 zpisc(jpdoc,1) = 2.04e-5_wp 104 zpisc(jptal,1) = 2.31e-3_wp 105 zpisc(jpoxy,1) = 2.47e-4_wp 106 zpisc(jpcal,1) = 1.04e-8_wp 107 zpisc(jppo4,1) = 5.77e-7_wp / po4r 108 zpisc(jppoc,1) = 1.27e-6_wp 90 109 # if ! defined key_kriest 91 IF ( cn_trc_o(jpgoc) == 'GL ' ) trc_o(:,:,jpgoc) = 5.23e-8_wp92 IF ( cn_trc_o(jpbfe) == 'GL ' ) trc_o(:,:,jpbfe) = 9.84e-13_wp110 zpisc(jpgoc,1) = 5.23e-8_wp 111 zpisc(jpbfe,1) = 9.84e-13_wp 93 112 # else 94 IF ( cn_trc_o(jpnum) == 'GL ' ) trc_o(:,:,jpnum) = 0. ! could not get this value since did not use it113 zpisc(jpnum,1) = 0. ! could not get this value since did not use it 95 114 # endif 96 IF ( cn_trc_o(jpsil) == 'GL ' ) trc_o(:,:,jpsil) = 7.36e-6_wp97 IF ( cn_trc_o(jpdsi) == 'GL ' ) trc_o(:,:,jpdsi) = 1.07e-7_wp98 IF ( cn_trc_o(jpgsi) == 'GL ' ) trc_o(:,:,jpgsi) = 1.53e-8_wp99 IF ( cn_trc_o(jpphy) == 'GL ' ) trc_o(:,:,jpphy) = 9.57e-8_wp100 IF ( cn_trc_o(jpdia) == 'GL ' ) trc_o(:,:,jpdia) = 4.24e-7_wp101 IF ( cn_trc_o(jpzoo) == 'GL ' ) trc_o(:,:,jpzoo) = 6.07e-7_wp102 IF ( cn_trc_o(jpmes) == 'GL ' ) trc_o(:,:,jpmes) = 3.44e-7_wp103 IF ( cn_trc_o(jpfer) == 'GL ' ) trc_o(:,:,jpfer) = 4.06e-10_wp104 IF ( cn_trc_o(jpsfe) == 'GL ' ) trc_o(:,:,jpsfe) = 2.51e-11_wp105 IF ( cn_trc_o(jpdfe) == 'GL ' ) trc_o(:,:,jpdfe) = 6.57e-12_wp106 IF ( cn_trc_o(jpnfe) == 'GL ' ) trc_o(:,:,jpnfe) = 1.76e-11_wp107 IF ( cn_trc_o(jpnch) == 'GL ' ) trc_o(:,:,jpnch) = 1.67e-7_wp108 IF ( cn_trc_o(jpdch) == 'GL ' ) trc_o(:,:,jpdch) = 1.02e-7_wp109 IF ( cn_trc_o(jpno3) == 'GL ' ) trc_o(:,:,jpno3) = 5.79e-6_wp / rno3110 IF ( cn_trc_o(jpnh4) == 'GL ' ) trc_o(:,:,jpnh4) = 3.22e-7_wp / rno3115 zpisc(jpsil,1) = 7.36e-6_wp 116 zpisc(jpdsi,1) = 1.07e-7_wp 117 zpisc(jpgsi,1) = 1.53e-8_wp 118 zpisc(jpphy,1) = 9.57e-8_wp 119 zpisc(jpdia,1) = 4.24e-7_wp 120 zpisc(jpzoo,1) = 6.07e-7_wp 121 zpisc(jpmes,1) = 3.44e-7_wp 122 zpisc(jpfer,1) = 4.06e-10_wp 123 zpisc(jpsfe,1) = 2.51e-11_wp 124 zpisc(jpdfe,1) = 6.57e-12_wp 125 zpisc(jpnfe,1) = 1.76e-11_wp 126 zpisc(jpnch,1) = 1.67e-7_wp 127 zpisc(jpdch,1) = 1.02e-7_wp 128 zpisc(jpno3,1) = 5.79e-6_wp / rno3 129 zpisc(jpnh4,1) = 3.22e-7_wp / rno3 111 130 112 131 !--- Arctic specificities (dissolved inorganic & DOM) 113 IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdic) = 1.98e-3_wp ; END WHERE ; ENDIF114 IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdoc) = 6.00e-6_wp ; END WHERE ; ENDIF115 IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jptal) = 2.13e-3_wp ; END WHERE ; ENDIF116 IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpoxy) = 3.65e-4_wp ; END WHERE ; ENDIF117 IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpcal) = 1.50e-9_wp ; END WHERE ; ENDIF118 IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppo4) = 4.09e-7_wp / po4r ; END WHERE ; ENDIF119 IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jppoc) = 4.05e-7_wp ; END WHERE ; ENDIF132 zpisc(jpdic,2) = 1.98e-3_wp 133 zpisc(jpdoc,2) = 6.00e-6_wp 134 zpisc(jptal,2) = 2.13e-3_wp 135 zpisc(jpoxy,2) = 3.65e-4_wp 136 zpisc(jpcal,2) = 1.50e-9_wp 137 zpisc(jppo4,2) = 4.09e-7_wp / po4r 138 zpisc(jppoc,2) = 4.05e-7_wp 120 139 # if ! defined key_kriest 121 IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgoc) = 2.84e-8_wp ; END WHERE ; ENDIF122 IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpbfe) = 7.03e-13_wp ; END WHERE ; ENDIF140 zpisc(jpgoc,2) = 2.84e-8_wp 141 zpisc(jpbfe,2) = 7.03e-13_wp 123 142 # else 124 IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnum) = 0.00e-00_wp ; END WHERE ; ENDIF143 zpisc(jpnum,2) = 0.00e-00_wp 125 144 # endif 126 IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsil) = 6.87e-6_wp ; END WHERE ; ENDIF127 IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdsi) = 1.73e-7_wp ; END WHERE ; ENDIF128 IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpgsi) = 7.93e-9_wp ; END WHERE ; ENDIF129 IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpphy) = 5.25e-7_wp ; END WHERE ; ENDIF130 IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdia) = 7.75e-7_wp ; END WHERE ; ENDIF131 IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpzoo) = 3.34e-7_wp ; END WHERE ; ENDIF132 IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpmes) = 2.49e-7_wp ; END WHERE ; ENDIF133 IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpfer) = 1.43e-9_wp ; END WHERE ; ENDIF134 IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpsfe) = 2.21e-11_wp ; END WHERE ; ENDIF135 IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdfe) = 2.04e-11_wp ; END WHERE ; ENDIF136 IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnfe) = 1.75e-11_wp ; END WHERE ; ENDIF137 IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnch) = 1.46e-07_wp ; END WHERE ; ENDIF138 IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpdch) = 2.36e-07_wp ; END WHERE ; ENDIF139 IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpno3) = 3.51e-06_wp / rno3 ; END WHERE ; ENDIF140 IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) >= 00._wp ) ; trc_o(:,:,jpnh4) = 6.15e-08_wp / rno3 ; END WHERE ; ENDIF145 zpisc(jpsil,2) = 6.87e-6_wp 146 zpisc(jpdsi,2) = 1.73e-7_wp 147 zpisc(jpgsi,2) = 7.93e-9_wp 148 zpisc(jpphy,2) = 5.25e-7_wp 149 zpisc(jpdia,2) = 7.75e-7_wp 150 zpisc(jpzoo,2) = 3.34e-7_wp 151 zpisc(jpmes,2) = 2.49e-7_wp 152 zpisc(jpfer,2) = 1.43e-9_wp 153 zpisc(jpsfe,2) = 2.21e-11_wp 154 zpisc(jpdfe,2) = 2.04e-11_wp 155 zpisc(jpnfe,2) = 1.75e-11_wp 156 zpisc(jpnch,2) = 1.46e-07_wp 157 zpisc(jpdch,2) = 2.36e-07_wp 158 zpisc(jpno3,2) = 3.51e-06_wp / rno3 159 zpisc(jpnh4,2) = 6.15e-08_wp / rno3 141 160 142 161 !--- Antarctic specificities (dissolved inorganic & DOM) 143 IF ( cn_trc_o(jpdic) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdic) = 2.20e-3_wp ; END WHERE ; ENDIF144 IF ( cn_trc_o(jpdoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdoc) = 7.02e-6_wp ; END WHERE ; ENDIF145 IF ( cn_trc_o(jptal) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jptal) = 2.37e-3_wp ; END WHERE ; ENDIF146 IF ( cn_trc_o(jpoxy) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpoxy) = 3.42e-4_wp ; END WHERE ; ENDIF147 IF ( cn_trc_o(jpcal) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpcal) = 3.17e-9_wp ; END WHERE ; ENDIF148 IF ( cn_trc_o(jppo4) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jppo4) = 1.88e-6_wp / po4r ; END WHERE ; ENDIF149 IF ( cn_trc_o(jppoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jppoc) = 1.13e-6_wp ; END WHERE ; ENDIF162 zpisc(jpdic,3) = 2.20e-3_wp 163 zpisc(jpdoc,3) = 7.02e-6_wp 164 zpisc(jptal,3) = 2.37e-3_wp 165 zpisc(jpoxy,3) = 3.42e-4_wp 166 zpisc(jpcal,3) = 3.17e-9_wp 167 zpisc(jppo4,3) = 1.88e-6_wp / po4r 168 zpisc(jppoc,3) = 1.13e-6_wp 150 169 # if ! defined key_kriest 151 IF ( cn_trc_o(jpgoc) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpgoc) = 2.89e-8_wp ; END WHERE ; ENDIF152 IF ( cn_trc_o(jpbfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpbfe) = 5.63e-13_wp ; END WHERE ; ENDIF170 zpisc(jpgoc,3) = 2.89e-8_wp 171 zpisc(jpbfe,3) = 5.63e-13_wp 153 172 # else 154 IF ( cn_trc_o(jpnum) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnum) = 0.00e-00_wp ; END WHERE ; ENDIF173 zpisc(jpnum,3) = 0.00e-00_wp 155 174 # endif 156 IF ( cn_trc_o(jpsil) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpsil) = 4.96e-5_wp ; END WHERE ; ENDIF157 IF ( cn_trc_o(jpdsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdsi) = 5.63e-7_wp ; END WHERE ; ENDIF158 IF ( cn_trc_o(jpgsi) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpgsi) = 5.35e-8_wp ; END WHERE ; ENDIF159 IF ( cn_trc_o(jpphy) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpphy) = 8.10e-7_wp ; END WHERE ; ENDIF160 IF ( cn_trc_o(jpdia) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdia) = 5.77e-7_wp ; END WHERE ; ENDIF161 IF ( cn_trc_o(jpzoo) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpzoo) = 6.68e-7_wp ; END WHERE ; ENDIF162 IF ( cn_trc_o(jpmes) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpmes) = 3.55e-7_wp ; END WHERE ; ENDIF163 IF ( cn_trc_o(jpfer) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpfer) = 1.62e-10_wp ; END WHERE ; ENDIF164 IF ( cn_trc_o(jpsfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpsfe) = 2.29e-11_wp ; END WHERE ; ENDIF165 IF ( cn_trc_o(jpdfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdfe) = 8.75e-12_wp ; END WHERE ; ENDIF166 IF ( cn_trc_o(jpnfe) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnfe) = 1.48e-11_wp ; END WHERE ; ENDIF167 IF ( cn_trc_o(jpnch) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnch) = 2.02e-7_wp ; END WHERE ; ENDIF168 IF ( cn_trc_o(jpdch) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpdch) = 1.60e-7_wp ; END WHERE ; ENDIF169 IF ( cn_trc_o(jpno3) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpno3) = 2.64e-5_wp / rno3 ; END WHERE ; ENDIF170 IF ( cn_trc_o(jpnh4) == 'AA ' ) THEN ; WHERE( gphit(:,:) < 00._wp ) ; trc_o(:,:,jpnh4) = 3.39e-7_wp / rno3 ; END WHERE ; ENDIF175 zpisc(jpsil,3) = 4.96e-5_wp 176 zpisc(jpdsi,3) = 5.63e-7_wp 177 zpisc(jpgsi,3) = 5.35e-8_wp 178 zpisc(jpphy,3) = 8.10e-7_wp 179 zpisc(jpdia,3) = 5.77e-7_wp 180 zpisc(jpzoo,3) = 6.68e-7_wp 181 zpisc(jpmes,3) = 3.55e-7_wp 182 zpisc(jpfer,3) = 1.62e-10_wp 183 zpisc(jpsfe,3) = 2.29e-11_wp 184 zpisc(jpdfe,3) = 8.75e-12_wp 185 zpisc(jpnfe,3) = 1.48e-11_wp 186 zpisc(jpnch,3) = 2.02e-7_wp 187 zpisc(jpdch,3) = 1.60e-7_wp 188 zpisc(jpno3,3) = 2.64e-5_wp / rno3 189 zpisc(jpnh4,3) = 3.39e-7_wp / rno3 171 190 172 191 !--- Baltic Sea particular case for ORCA configurations 173 IF( cp_cfg == "orca" ) THEN ! Baltic mask 174 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 175 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 176 trc_o(:,:,jpdic) = 1.14e-3_wp 177 trc_o(:,:,jpdoc) = 1.06e-5_wp 178 trc_o(:,:,jptal) = 1.16e-3_wp 179 trc_o(:,:,jpoxy) = 3.71e-4_wp 180 trc_o(:,:,jpcal) = 1.51e-9_wp 181 trc_o(:,:,jppo4) = 2.85e-9_wp / po4r 182 trc_o(:,:,jppoc) = 4.84e-7_wp 192 zpisc(jpdic,4) = 1.14e-3_wp 193 zpisc(jpdoc,4) = 1.06e-5_wp 194 zpisc(jptal,4) = 1.16e-3_wp 195 zpisc(jpoxy,4) = 3.71e-4_wp 196 zpisc(jpcal,4) = 1.51e-9_wp 197 zpisc(jppo4,4) = 2.85e-9_wp / po4r 198 zpisc(jppoc,4) = 4.84e-7_wp 183 199 # if ! defined key_kriest 184 trc_o(:,:,jpgoc) = 1.05e-8_wp185 trc_o(:,:,jpbfe) = 4.97e-13_wp200 zpisc(jpgoc,4) = 1.05e-8_wp 201 zpisc(jpbfe,4) = 4.97e-13_wp 186 202 # else 187 trc_o(:,:,jpnum) = 0. ! could not get this value203 zpisc(jpnum,4) = 0. ! could not get this value 188 204 # endif 189 trc_o(:,:,jpsil) = 4.91e-5_wp 190 trc_o(:,:,jpdsi) = 3.25e-7_wp 191 trc_o(:,:,jpgsi) = 1.93e-8_wp 192 trc_o(:,:,jpphy) = 6.64e-7_wp 193 trc_o(:,:,jpdia) = 3.41e-7_wp 194 trc_o(:,:,jpzoo) = 3.83e-7_wp 195 trc_o(:,:,jpmes) = 0.225e-6_wp 196 trc_o(:,:,jpfer) = 2.45e-9_wp 197 trc_o(:,:,jpsfe) = 3.89e-11_wp 198 trc_o(:,:,jpdfe) = 1.33e-11_wp 199 trc_o(:,:,jpnfe) = 2.62e-11_wp 200 trc_o(:,:,jpnch) = 1.17e-7_wp 201 trc_o(:,:,jpdch) = 9.69e-8_wp 202 trc_o(:,:,jpno3) = 5.36e-5_wp / rno3 203 trc_o(:,:,jpnh4) = 7.18e-7_wp / rno3 204 END WHERE 205 ENDIF ! cfg 205 zpisc(jpsil,4) = 4.91e-5_wp 206 zpisc(jpdsi,4) = 3.25e-7_wp 207 zpisc(jpgsi,4) = 1.93e-8_wp 208 zpisc(jpphy,4) = 6.64e-7_wp 209 zpisc(jpdia,4) = 3.41e-7_wp 210 zpisc(jpzoo,4) = 3.83e-7_wp 211 zpisc(jpmes,4) = 0.225e-6_wp 212 zpisc(jpfer,4) = 2.45e-9_wp 213 zpisc(jpsfe,4) = 3.89e-11_wp 214 zpisc(jpdfe,4) = 1.33e-11_wp 215 zpisc(jpnfe,4) = 2.62e-11_wp 216 zpisc(jpnch,4) = 1.17e-7_wp 217 zpisc(jpdch,4) = 9.69e-8_wp 218 zpisc(jpno3,4) = 5.36e-5_wp / rno3 219 zpisc(jpnh4,4) = 7.18e-7_wp / rno3 220 221 DO jn = jp_pcs0, jp_pcs1 222 IF( cn_trc_o(jn) == 'GL ' ) trc_o(:,:,jn) = zpisc(jn,1) ! Global case 223 IF( cn_trc_o(jn) == 'AA ' ) THEN 224 WHERE( gphit(:,:) >= 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,2) ; END WHERE ! Arctic 225 WHERE( gphit(:,:) < 0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic 226 ENDIF 227 IF( cp_cfg == "orca" ) THEN ! Baltic Sea particular case for ORCA configurations 228 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 229 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 230 trc_o(:,:,jn) = zpisc(jn,4) 231 END WHERE 232 ENDIF 233 ENDDO 234 235 206 236 207 237 !----------------------------- … … 217 247 218 248 DO jn = jp_pcs0, jp_pcs1 219 IF 220 IF 221 IF 249 IF( trc_ice_ratio(jn) >= 0._wp ) zratio(jn,:) = trc_ice_ratio(jn) 250 IF( trc_ice_ratio(jn) == -1._wp ) zratio(jn,:) = zrs(:) 251 IF( trc_ice_ratio(jn) == -2._wp ) zratio(jn,:) = -9999.99_wp 222 252 END DO 223 253 … … 227 257 DO jn = jp_pcs0, jp_pcs1 228 258 !-- Everywhere but in the Baltic 229 IF ( trc_ice_ratio(jn) >= -1._wp ) THEN !! no prescribed concentration 230 !! (typically everything but iron) 259 IF ( trc_ice_ratio(jn) >= -1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 231 260 trc_i(:,:,jn) = zratio(jn,1) * trc_o(:,:,jn) 232 ELSE !! prescribed concentration261 ELSE ! prescribed concentration 233 262 trc_i(:,:,jn) = trc_ice_prescr(jn) 234 263 ENDIF 235 264 236 265 !-- Baltic 237 IF( cp_cfg == "orca" ) THEN !! Baltic treated seperately for ORCA configs 238 IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN !! no prescribed concentration 239 !! (typically everything but iron) 266 IF( cp_cfg == "orca" ) THEN ! Baltic treated seperately for ORCA configs 267 IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron) 240 268 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 241 269 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 242 270 trc_i(:,:,jn) = zratio(jn,2) * trc_o(:,:,jn) 243 271 END WHERE 244 ELSE ! !prescribed tracer concentration in ice272 ELSE ! prescribed tracer concentration in ice 245 273 WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. & 246 274 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) … … 251 279 ! 252 280 END DO ! jn 253 254 END SUBROUTINE trc_ice_ini_pisces 281 #endif 282 283 END SUBROUTINE p4z_ice_ini 284 285 SUBROUTINE p2z_ice_ini 286 #if defined key_pisces_reduced 287 !!---------------------------------------------------------------------- 288 !! *** ROUTINE p2z_ice_ini *** 289 !! 290 !! ** Purpose : Initialisation of the LOBSTER biochemical model 291 !!---------------------------------------------------------------------- 292 #endif 293 END SUBROUTINE p2z_ice_ini 294 255 295 256 296 #else -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r10251 r10253 56 56 INTEGER, INTENT( in ) :: kt ! ocean time-step index 57 57 !! 58 INTEGER :: jn 58 INTEGER :: jn, jk 59 59 CHARACTER (len=22) :: charout 60 60 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd … … 105 105 DO jn = 1, jptra 106 106 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 107 #if defined key_tracer_budget 108 DO jk = 1, jpkm1 109 ztrtrd(:,:,jk,jn) = ztrtrd(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) ! slwa 110 END DO 111 #endif 107 112 CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) ) 108 113 END DO -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r10251 r10253 33 33 USE trdtra 34 34 USE tranxt 35 USE trcbdy ! BDY open boundaries 36 USE bdy_par, only: lk_bdy 37 USE iom 35 38 # if defined key_agrif 36 39 USE agrif_top_interp … … 93 96 CHARACTER (len=22) :: charout 94 97 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrdt 98 #if defined key_tracer_budget 99 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ztrdt_m1 ! slwa 100 #endif 95 101 !!---------------------------------------------------------------------- 96 102 ! … … 101 107 WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 102 108 ENDIF 103 109 #if defined key_tracer_budget 110 IF( kt == nittrc000 .AND. l_trdtrc ) THEN 111 ALLOCATE( ztrdt_m1(jpi,jpj,jpk,jptra) ) ! slwa 112 IF( ln_rsttr .AND. & ! Restart: read in restart file 113 iom_varid( numrtr, 'atf_trend_'//TRIM(ctrcnm(1)), ldstop = .FALSE. ) > 0 ) THEN 114 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc ATF tracer trend read in the restart file' 115 DO jn = 1, jptra 116 CALL iom_get( numrtr, jpdom_autoglo, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) ) ! before tracer trend for atf 117 END DO 118 ELSE 119 ztrdt_m1=0.0 120 ENDIF 121 ENDIF 122 #endif 123 124 125 #if defined key_agrif 126 CALL Agrif_trc ! AGRIF zoom boundaries 127 #endif 104 128 ! Update after tracer on domain lateral boundaries 105 129 DO jn = 1, jptra … … 108 132 109 133 110 #if defined key_bdy 111 !! CALL bdy_trc( kt ) ! BDY open boundaries 112 #endif 113 #if defined key_agrif 114 CALL Agrif_trc ! AGRIF zoom boundaries 115 #endif 134 IF( lk_bdy ) CALL trc_bdy( kt ) ! BDY open boundaries 116 135 117 136 … … 149 168 zfact = 1.e0 / r2dt(jk) 150 169 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 151 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 170 !slwa CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt ) 171 #if defined key_tracer_budget 172 ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_n(:,:,jk) ! slwa vvl 173 !ztrdt(:,:,jk,jn) = ztrdt(:,:,jk,jn) * e1t(:,:) * e2t(:,:) * e3t_0(:,:,jk) ! slwa CHANGE for vvl 174 #endif 152 175 END DO 176 #if defined key_tracer_budget 177 ! slwa budget code 178 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt_m1(:,:,:,jn) ) 179 #else 180 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 181 #endif 153 182 END DO 183 #if defined key_tracer_budget 184 ztrdt_m1(:,:,:,:) = ztrdt(:,:,:,:) ! need previous time step for budget slwa 185 #endif 154 186 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt ) 155 187 END IF 188 189 #if defined key_tracer_budget 190 ! Write in the tracer restart file 191 ! ******************************* 192 IF( lrst_trc ) THEN 193 IF(lwp) WRITE(numout,*) 194 IF(lwp) WRITE(numout,*) 'trc : ATF trend at last time step for tracer budget written in tracer restart file ', & 195 & 'at it= ', kt,' date= ', ndastp 196 IF(lwp) WRITE(numout,*) '~~~~' 197 DO jn = 1, jptra 198 CALL iom_rstput( kt, nitrst, numrtw, 'atf_trend_'//TRIM(ctrcnm(jn)), ztrdt_m1(:,:,:,jn) ) 199 END DO 200 ENDIF 201 #endif 202 156 203 ! 157 204 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90
r10251 r10253 18 18 USE trdtra 19 19 USE prtctl_trc ! Print control for debbuging 20 #if defined key_tracer_budget 21 USE iom 22 #endif 20 23 21 24 IMPLICIT NONE … … 51 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 52 55 CHARACTER (len=22) :: charout 56 ! +++>>> FABM 57 INTEGER :: jn 58 ! FABM <<<+++ 53 59 !!---------------------------------------------------------------------- 54 60 ! … … 65 71 IF( lk_pisces ) CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' ) ! PISCES model 66 72 IF( lk_my_trc ) CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1 ) ! MY_TRC model 67 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 <<<+++ 68 82 ! 69 83 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 110 124 REAL(wp) :: zcoef, ztrcorn, ztrmasn ! " " 111 125 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 126 #if defined key_tracer_budget 127 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: ztrtrdb_m1 ! slwa 128 #endif 112 129 REAL(wp) :: zs2rdt 113 130 LOGICAL :: lldebug = .FALSE. … … 116 133 117 134 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 135 #if defined key_tracer_budget 136 IF( kt == nittrc000 .AND. l_trdtrc) THEN 137 IF (.not. ALLOCATED(ztrtrdb_m1)) ALLOCATE( ztrtrdb_m1(jpi,jpj,jpk,jptra) ) ! slwa 138 DO jn = jp_sms0, jp_sms1 139 IF( ln_rsttr .AND. & ! Restart: read in restart file 140 iom_varid( numrtr, 'rdb_trend_'//TRIM(ctrcnm(jn)), ldstop = .FALSE. ) > 0 ) THEN 141 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc RDB tracer trend read for',TRIM(ctrcnm(jn)) 142 CALL iom_get( numrtr, jpdom_autoglo, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) ) ! before tracer trend for rdb 143 ELSE 144 IF(lwp) WRITE(numout,*) ' no nittrc000-nn_dttrc RDB tracer trend for',TRIM(ctrcnm(jn)),', setting to 0.' 145 ztrtrdb_m1(:,:,:,jn)=0.0 146 ENDIF 147 END DO 148 ENDIF 149 #endif 118 150 119 151 IF( PRESENT( cpreserv ) ) THEN ! total tracer concentration is preserved … … 156 188 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 157 189 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 190 #if defined key_tracer_budget 191 ! slwa budget code 192 DO jk = 1, jpkm1 193 ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 194 ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 195 END DO 196 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 197 ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 198 #else 158 199 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 200 #endif 159 201 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 160 202 ! … … 187 229 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 188 230 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 231 #if defined key_tracer_budget 232 ! slwa budget code 233 DO jk = 1, jpkm1 234 ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 235 ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 236 END DO 237 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 238 ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 239 #else 189 240 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 241 #endif 190 242 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 191 243 ! … … 195 247 196 248 ENDIF 249 250 #if defined key_tracer_budget 251 ! Write in the tracer restart file 252 ! ******************************* 253 IF( lrst_trc ) THEN 254 IF(lwp) WRITE(numout,*) 255 IF(lwp) WRITE(numout,*) 'trc : RDB trend at last time step for tracer budget written in tracer restart file ', & 256 & 'at it= ', kt,' date= ', ndastp 257 IF(lwp) WRITE(numout,*) '~~~~' 258 DO jn = jp_sms0, jp_sms1 259 CALL iom_rstput( kt, nitrst, numrtw, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) ) 260 END DO 261 ENDIF 262 #endif 197 263 198 264 IF( l_trdtrc ) CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r10251 r10253 113 113 sbc_trc_b(:,:,:) = 0._wp 114 114 ENDIF 115 sbc_trc(:,:,:) = 0._wp !slwa initialise for vvl 115 116 ELSE ! Swap of forcing fields 116 117 IF( ln_top_euler ) THEN -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r10251 r10253 27 27 USE trcsbc ! surface boundary condition (trc_sbc routine) 28 28 USE zpshde ! partial step: hor. derivative (zps_hde routine) 29 USE trcbdy ! BDY open boundaries 30 USE bdy_par, only: lk_bdy 29 31 30 32 #if defined key_agrif … … 68 70 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 71 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 72 IF( lk_bdy ) CALL trc_bdy_dmp( kstp ) ! BDY damping trends 70 73 CALL trc_adv( kstp ) ! horizontal & vertical advection 71 74 CALL trc_ldf( kstp ) ! lateral mixing -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
r10251 r10253 102 102 END SELECT 103 103 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 104 ! +++>>>FABM 105 #if defined key_tracer_budget 106 ! for outputting depth integrated 107 SELECT CASE( ktrd ) 108 CASE( jptra_xad, jptra_yad, jptra_zad ) 109 cltra = TRIM(cltra)//"_e3t" 110 END SELECT 111 #endif 112 ! FABM <<<+++ 104 113 CALL iom_put( cltra, ptrtrd(:,:,:) ) 105 114 ! -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
r10251 r10253 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/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r10251 r10253 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/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trc.F90
r10251 r10253 14 14 USE par_oce 15 15 USE par_trc 16 #if defined key_bdy 17 USE bdy_oce, only: nb_bdy, OBC_DATA 18 #endif 16 19 17 20 IMPLICIT NONE … … 80 83 END TYPE 81 84 82 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 83 92 trc_ice_prescr ! prescribed ice trc cc 84 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 <<<+++ 85 95 86 96 !! information for outputs … … 90 100 CHARACTER(len = 80) :: cllname !: long name 91 101 CHARACTER(len = 20) :: clunit !: unit 92 LOGICAL :: llinit !: read in a file or not 93 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 <<<+++ 94 120 END TYPE PTRACER 95 121 CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ctrcnm !: tracer name … … 191 217 # endif 192 218 ! 219 #if defined key_bdy 220 CHARACTER(len=20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc_dflt ! Default OBC condition for all tracers 221 CHARACTER(len=20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc ! Choice of boundary condition for tracers 222 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nn_trcdmp_bdy !: =T Tracer damping 223 ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 224 TYPE(OBC_DATA), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: trcdta_bdy !: bdy external data (local process) 225 #endif 193 226 194 227 !!---------------------------------------------------------------------- … … 213 246 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , & 214 247 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 248 ! --->>> FABM 249 !!#if defined key_my_trc 250 ! FABM <<<--- 251 ! +++>>> FABM 252 #if defined key_fabm 253 ! FABM <<<+++ 254 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & 255 #endif 256 #if defined key_bdy 257 & cn_trc_dflt(nb_bdy) , cn_trc(nb_bdy) , nn_trcdmp_bdy(nb_bdy) , & 258 & trcdta_bdy(jptra,nb_bdy) , & 259 #endif 215 260 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , STAT = trc_alloc ) 216 261 -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r10251 r10253 4 4 !! TOP : module for passive tracer boundary conditions 5 5 !!===================================================================== 6 !!---------------------------------------------------------------------- 7 #if defined key_top 6 !! History : 3.5 ! 2014-04 (M. Vichi, T. Lovato) Original 7 !! 3.6 ! 2015-03 (T . Lovato) Revision and BDY support 8 !!---------------------------------------------------------------------- 9 #if defined key_top 8 10 !!---------------------------------------------------------------------- 9 11 !! 'key_top' TOP model 10 12 !!---------------------------------------------------------------------- 11 !! trc_ dta : read and time interpolated passive tracer data13 !! trc_bc : read and time interpolated tracer Boundary Conditions 12 14 !!---------------------------------------------------------------------- 13 15 USE par_trc ! passive tracers parameters … … 17 19 USE lib_mpp ! MPP library 18 20 USE fldread ! read input fields 21 #if defined key_bdy 22 USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out 23 #endif 19 24 20 25 IMPLICIT NONE … … 24 29 PUBLIC trc_bc_read ! called in trcstp.F90 or within 25 30 26 INTEGER , SAVE, PUBLIC :: nb_trcobc ! number of tracers with open BC27 INTEGER , SAVE, PUBLIC :: nb_trcsbc ! number of tracers with surface BC28 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 29 34 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indobc ! index of tracer with OBC data 30 35 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indsbc ! index of tracer with SBC data 31 36 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_indcbc ! index of tracer with CBC data 32 INTEGER , SAVE, PUBLIC :: ntra_obc ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 33 INTEGER , SAVE, PUBLIC :: ntra_sbc ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 34 INTEGER , SAVE, PUBLIC :: ntra_cbc ! MAX( 1, nb_trcxxx ) to avoid compilation error with bounds checking 35 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trofac ! multiplicative factor for OBCtracer values 36 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcobc ! structure of data input OBC (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) 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 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: rf_trofac ! multiplicative factor for OBCtracer values 42 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: sf_trcobc ! structure of data input OBC (file informations, fields read) 43 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:,:) :: nbmap_ptr ! array of pointers to nbmap 41 44 42 45 !! * Substitutions 43 46 # include "domzgr_substitute.h90" 44 47 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)48 !! NEMO/OPA 3.6 , NEMO Consortium (2015) 46 49 !! $Id$ 47 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 60 63 ! 61 64 INTEGER,INTENT(IN) :: ntrc ! number of tracers 62 INTEGER :: jl, jn 65 INTEGER :: jl, jn , ib, ibd, ii, ij, ik ! dummy loop indices 63 66 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 64 INTEGER :: ios ! Local integer output status for namelist read 67 INTEGER :: ios ! Local integer output status for namelist read 68 INTEGER :: nblen, igrd ! support arrays for BDY 65 69 CHARACTER(len=100) :: clndta, clntrc 66 70 ! 67 CHARACTER(len=100) :: cn_dir 71 CHARACTER(len=100) :: cn_dir_sbc, cn_dir_cbc, cn_dir_obc 72 68 73 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! local array of namelist informations on the fields to read 69 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc ! open 74 TYPE(FLD_N), DIMENSION(jpmaxtrc,2) :: sn_trcobc ! open 75 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcobc2 ! to read in multiple (2) open bdy 70 76 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcsbc ! surface 71 77 TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trccbc ! coastal … … 74 80 REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trcfac ! multiplicative factor for tracer values 75 81 !! 76 NAMELIST/namtrc_bc/ cn_dir, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 82 NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc2, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 83 #if defined key_bdy 84 NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 85 #endif 77 86 !!---------------------------------------------------------------------- 78 87 IF( nn_timing == 1 ) CALL timing_start('trc_bc_init') 79 88 ! 89 IF( lwp ) THEN 90 WRITE(numout,*) ' ' 91 WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)' 92 WRITE(numout,*) '~~~~~~~~~~~ ' 93 ENDIF 80 94 ! Initialisation and local array allocation 81 95 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 … … 107 121 n_trc_indcbc(:) = 0 108 122 ! 109 DO jn = 1, ntrc 110 IF( ln_trc_obc(jn) ) THEN 111 nb_trcobc = nb_trcobc + 1 112 n_trc_indobc(jn) = nb_trcobc 113 ENDIF 114 IF( ln_trc_sbc(jn) ) THEN 115 nb_trcsbc = nb_trcsbc + 1 116 n_trc_indsbc(jn) = nb_trcsbc 117 ENDIF 118 IF( ln_trc_cbc(jn) ) THEN 119 nb_trccbc = nb_trccbc + 1 120 n_trc_indcbc(jn) = nb_trccbc 121 ENDIF 122 ENDDO 123 ntra_obc = MAX( 1, nb_trcobc ) ! To avoid compilation error with bounds checking 124 IF( lwp ) WRITE(numout,*) ' ' 125 IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with open boundary data :', nb_trcobc 126 IF( lwp ) WRITE(numout,*) ' ' 127 ntra_sbc = MAX( 1, nb_trcsbc ) ! To avoid compilation error with bounds checking 128 IF( lwp ) WRITE(numout,*) ' ' 129 IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with surface boundary data :', nb_trcsbc 130 IF( lwp ) WRITE(numout,*) ' ' 131 ntra_cbc = MAX( 1, nb_trccbc ) ! To avoid compilation error with bounds checking 132 IF( lwp ) WRITE(numout,*) ' ' 133 IF( lwp ) WRITE(numout,*) ' Number of passive tracers to be initialized with coastal boundary data :', nb_trccbc 134 IF( lwp ) WRITE(numout,*) ' ' 135 123 ! Read Boundary Conditions Namelists 136 124 REWIND( numnat_ref ) ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 137 125 READ ( numnat_ref, namtrc_bc, IOSTAT = ios, ERR = 901) … … 139 127 140 128 REWIND( numnat_cfg ) ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 141 READ ( numnat_cfg, namtrc_bc, IOSTAT = ios, ERR = 902 ) 142 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bc in configuration namelist', lwp ) 143 IF(lwm) WRITE ( numont, namtrc_bc ) 144 145 ! print some information for each 129 #if defined key_bdy 130 DO ib = 1, nb_bdy 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 ) 135 #if defined key_bdy 136 sn_trcobc(:,ib)=sn_trcobc2(:) 137 ENDDO 138 #endif 139 140 #if defined key_bdy 141 REWIND( numnat_ref ) ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 142 READ ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 143 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 144 145 REWIND( numnat_cfg ) ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 146 READ ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 147 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 148 IF(lwm) WRITE ( numont, namtrc_bdy ) 149 ! setup up preliminary informations for BDY structure 150 DO jn = 1, ntrc 151 DO ib = 1, nb_bdy 152 ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 153 IF ( ln_trc_obc(jn) ) THEN 154 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 155 ELSE 156 trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 157 ENDIF 158 ! set damping use in BDY data structure 159 trcdta_bdy(jn,ib)%dmp = .false. 160 IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 161 IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 162 IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 ) & 163 & CALL ctl_stop( 'Use FRS OR relaxation' ) 164 IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2) & 165 & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 166 ENDDO 167 ENDDO 168 169 #else 170 ! Force all tracers OBC to false if bdy not used 171 ln_trc_obc = .false. 172 #endif 173 ! compose BC data indexes 174 DO jn = 1, ntrc 175 IF( ln_trc_obc(jn) ) THEN 176 nb_trcobc = nb_trcobc + 1 ; n_trc_indobc(jn) = nb_trcobc 177 ENDIF 178 IF( ln_trc_sbc(jn) ) THEN 179 nb_trcsbc = nb_trcsbc + 1 ; n_trc_indsbc(jn) = nb_trcsbc 180 ENDIF 181 IF( ln_trc_cbc(jn) ) THEN 182 nb_trccbc = nb_trccbc + 1 ; n_trc_indcbc(jn) = nb_trccbc 183 ENDIF 184 ENDDO 185 186 ! Print summmary of Boundary Conditions 146 187 IF( lwp ) THEN 147 DO jn = 1, ntrc 148 IF( ln_trc_obc(jn) ) THEN 149 clndta = TRIM( sn_trcobc(jn)%clvar ) 150 IF(lwp) WRITE(numout,*) 'Preparing to read OBC data file for passive tracer number :', jn, ' name : ', clndta, & 151 & ' multiplicative factor : ', rn_trofac(jn) 152 ENDIF 153 IF( ln_trc_sbc(jn) ) THEN 154 clndta = TRIM( sn_trcsbc(jn)%clvar ) 155 IF(lwp) WRITE(numout,*) 'Preparing to read SBC data file for passive tracer number :', jn, ' name : ', clndta, & 156 & ' multiplicative factor : ', rn_trsfac(jn) 157 ENDIF 158 IF( ln_trc_cbc(jn) ) THEN 159 clndta = TRIM( sn_trccbc(jn)%clvar ) 160 IF(lwp) WRITE(numout,*) 'Preparing to read CBC data file for passive tracer number :', jn, ' name : ', clndta, & 161 & ' multiplicative factor : ', rn_trcfac(jn) 162 ENDIF 163 END DO 164 ENDIF 165 ! 166 ! The following code is written this way to reduce memory usage and repeated for each boundary data 167 ! MAV: note that this is just a placeholder and the dimensions must be changed according to 168 ! what will be done with BDY. A new structure will probably need to be included 169 ! 188 WRITE(numout,*) ' ' 189 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with SURFACE BCs data:', nb_trcsbc 190 IF ( nb_trcsbc > 0 ) THEN 191 WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. ' 192 DO jn = 1, ntrc 193 IF ( ln_trc_sbc(jn) ) WRITE(numout,9001) jn, TRIM( sn_trcsbc(jn)%clvar ), 'SBC', rn_trsfac(jn) 194 ENDDO 195 ENDIF 196 WRITE(numout,'(2a)') ' SURFACE BC data repository : ', TRIM(cn_dir_sbc) 197 198 WRITE(numout,*) ' ' 199 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 200 IF ( nb_trccbc > 0 ) THEN 201 WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. ' 202 DO jn = 1, ntrc 203 IF ( ln_trc_cbc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trccbc(jn)%clvar ), 'CBC', rn_trcfac(jn) 204 ENDDO 205 ENDIF 206 WRITE(numout,'(2a)') ' COASTAL BC data repository : ', TRIM(cn_dir_cbc) 207 208 WRITE(numout,*) ' ' 209 WRITE(numout,'(a,i3)') ' Total tracers to be initialized with OPEN BCs data:', nb_trcobc 210 #if defined key_bdy 211 IF ( nb_trcobc > 0 ) THEN 212 WRITE(numout,*) ' #trc NAME Boundary Mult.Fact. OBC Settings' 213 DO jn = 1, ntrc 214 DO ib = 1, nb_bdy 215 IF ( ln_trc_obc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc) 216 ENDDO 217 !IF ( ln_trc_obc(jn) ) WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn,ib)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 218 IF ( .NOT. ln_trc_obc(jn) ) WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 219 ENDDO 220 WRITE(numout,*) ' ' 221 DO ib = 1, nb_bdy 222 IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) ' Boundary ',ib,' -> NO damping of tracers' 223 IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) ' Boundary ',ib,' -> damping ONLY for tracers with external data provided' 224 IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) ' Boundary ',ib,' -> damping of ALL tracers' 225 IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 226 WRITE(numout,9003) ' USE damping parameters from nambdy for boundary ', ib,' : ' 227 WRITE(numout,'(a,f10.2,a)') ' - Inflow damping time scale : ',rn_time_dmp(ib),' days' 228 WRITE(numout,'(a,f10.2,a)') ' - Outflow damping time scale : ',rn_time_dmp_out(ib),' days' 229 ENDIF 230 ENDDO 231 ENDIF 232 #endif 233 WRITE(numout,'(2a)') ' OPEN BC data repository : ', TRIM(cn_dir_obc) 234 ENDIF 235 9001 FORMAT(2x,i5, 3x, a15, 3x, a5, 6x, e11.3, 4x, 10a13) 236 9002 FORMAT(2x,i5, 3x, a41, 3x, 10a13) 237 9003 FORMAT(a, i5, a) 238 239 ! 240 #if defined key_bdy 170 241 ! OPEN Lateral boundary conditions 171 IF( nb_trcobc > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero172 ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), STAT=ierr1 )242 IF( nb_trcobc > 0 ) THEN 243 ALLOCATE ( sf_trcobc(nb_trcobc,nb_bdy), rf_trofac(nb_trcobc,nb_bdy), nbmap_ptr(nb_trcobc,nb_bdy), STAT=ierr1 ) 173 244 IF( ierr1 > 0 ) THEN 174 CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' ) ; RETURN 175 ENDIF 176 ! 177 DO jn = 1, ntrc 178 IF( ln_trc_obc(jn) ) THEN ! update passive tracers arrays with input data read from file 179 jl = n_trc_indobc(jn) 180 slf_i(jl) = sn_trcobc(jn) 181 rf_trofac(jl) = rn_trofac(jn) 182 ALLOCATE( sf_trcobc(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 ) 183 IF( sn_trcobc(jn)%ln_tint ) ALLOCATE( sf_trcobc(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 184 IF( ierr2 + ierr3 > 0 ) THEN 185 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' ) ; RETURN 245 CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' ) ; RETURN 246 ENDIF 247 248 igrd = 1 ! Everything is at T-points here 249 250 DO ib = 1, nb_bdy 251 DO jn = 1, ntrc 252 253 nblen = idx_bdy(ib)%nblen(igrd) 254 255 IF ( ln_trc_obc(jn) ) THEN 256 ! Initialise from external data 257 jl = n_trc_indobc(jn) 258 slf_i(jl) = sn_trcobc(jn,ib) 259 rf_trofac(jl,ib) = rn_trofac(jn) 260 ALLOCATE( sf_trcobc(jl,ib)%fnow(nblen,1,jpk) , STAT=ierr2 ) 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 ) THEN 263 CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' ) ; RETURN 264 ENDIF 265 trcdta_bdy(jn,ib)%trc => sf_trcobc(jl,ib)%fnow(:,1,:) 266 trcdta_bdy(jn,ib)%rn_fac = rf_trofac(jl,ib) 267 ! create OBC mapping array 268 nbmap_ptr(jl,ib)%ptr => idx_bdy(ib)%nbmap(:,igrd) 269 nbmap_ptr(jl,ib)%ll_unstruc = ln_coords_file(igrd) 270 ELSE 271 ! Initialise obc arrays from initial conditions 272 ALLOCATE ( trcdta_bdy(jn,ib)%trc(nblen,jpk) ) 273 DO ibd = 1, nblen 274 DO ik = 1, jpkm1 275 ii = idx_bdy(ib)%nbi(ibd,igrd) 276 ij = idx_bdy(ib)%nbj(ibd,igrd) 277 trcdta_bdy(jn,ib)%trc(ibd,ik) = trn(ii,ij,ik,jn) * tmask(ii,ij,ik) 278 END DO 279 END DO 280 trcdta_bdy(jn,ib)%rn_fac = 1._wp 186 281 ENDIF 187 END IF188 !282 ENDDO 283 CALL fld_fill( sf_trcobc(:,ib), slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 189 284 ENDDO 190 ! ! fill sf_trcdta with slf_i and control print 191 CALL fld_fill( sf_trcobc, slf_i, cn_dir, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 192 ! 193 ENDIF 194 ! 285 286 ENDIF 287 #endif 195 288 ! SURFACE Boundary conditions 196 289 IF( nb_trcsbc > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero … … 214 307 ENDDO 215 308 ! ! fill sf_trcsbc with slf_i and control print 216 CALL fld_fill( sf_trcsbc, slf_i, cn_dir , 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' )309 CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 217 310 ! 218 311 ENDIF … … 239 332 ENDDO 240 333 ! ! fill sf_trccbc with slf_i and control print 241 CALL fld_fill( sf_trccbc, slf_i, cn_dir , 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' )334 CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 242 335 ! 243 336 ENDIF … … 249 342 250 343 251 SUBROUTINE trc_bc_read(kt )344 SUBROUTINE trc_bc_read(kt, jit) 252 345 !!---------------------------------------------------------------------- 253 346 !! *** ROUTINE trc_bc_init *** … … 264 357 !! * Arguments 265 358 INTEGER, INTENT( in ) :: kt ! ocean time-step index 266 359 INTEGER, INTENT( in ), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option) 360 INTEGER :: ib 267 361 !!--------------------------------------------------------------------- 268 362 ! 269 363 IF( nn_timing == 1 ) CALL timing_start('trc_bc_read') 270 364 271 IF( kt == nit000 ) THEN 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 274 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 275 ENDIF 276 277 ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY 278 IF( nb_trcobc > 0 ) THEN 279 if (lwp) write(numout,'(a,i5,a,i5)') ' reading OBC data for ', nb_trcobc ,' variables at step ', kt 280 CALL fld_read(kt,1,sf_trcobc) 281 ! vertical interpolation on s-grid and partial step to be added 282 ENDIF 283 284 ! SURFACE boundary conditions 285 IF( nb_trcsbc > 0 ) THEN 286 if (lwp) write(numout,'(a,i5,a,i5)') ' reading SBC data for ', nb_trcsbc ,' variables at step ', kt 287 CALL fld_read(kt,1,sf_trcsbc) 288 ENDIF 289 290 ! COASTAL boundary conditions 291 IF( nb_trccbc > 0 ) THEN 292 if (lwp) write(numout,'(a,i5,a,i5)') ' reading CBC data for ', nb_trccbc ,' variables at step ', kt 293 CALL fld_read(kt,1,sf_trccbc) 294 ENDIF 365 IF( kt == nit000 .AND. lwp) THEN 366 WRITE(numout,*) 367 WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 368 WRITE(numout,*) '~~~~~~~~~~~ ' 369 ENDIF 370 371 IF ( PRESENT(jit) ) THEN 372 373 #ifdef key_bdy 374 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 375 IF( nb_trcobc > 0 ) THEN 376 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 377 DO ib = 1,nb_bdy 378 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kit=jit, kt_offset=+1) 379 ENDDO 380 ENDIF 381 #endif 382 383 ! SURFACE boundary conditions 384 IF( nb_trcsbc > 0 ) THEN 385 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 386 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc, kit=jit) 387 ENDIF 388 389 ! COASTAL boundary conditions 390 IF( nb_trccbc > 0 ) THEN 391 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 392 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc, kit=jit) 393 ENDIF 394 395 ELSE 396 397 #ifdef key_bdy 398 ! OPEN boundary conditions (use time_offset=+1 as they are applied at the end of the step) 399 IF( nb_trcobc > 0 ) THEN 400 if (lwp) write(numout,'(a,i5,a,i10)') ' reading OBC data for ', nb_trcobc ,' variable(s) at step ', kt 401 DO ib = 1,nb_bdy 402 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcobc(:,ib), map=nbmap_ptr(:,ib), kt_offset=+1) 403 ENDDO 404 ENDIF 405 #endif 406 407 ! SURFACE boundary conditions 408 IF( nb_trcsbc > 0 ) THEN 409 if (lwp) write(numout,'(a,i5,a,i10)') ' reading SBC data for ', nb_trcsbc ,' variable(s) at step ', kt 410 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trcsbc) 411 ENDIF 412 413 ! COASTAL boundary conditions 414 IF( nb_trccbc > 0 ) THEN 415 if (lwp) write(numout,'(a,i5,a,i10)') ' reading CBC data for ', nb_trccbc ,' variable(s) at step ', kt 416 CALL fld_read(kt=kt, kn_fsbc=1, sd=sf_trccbc) 417 ENDIF 418 419 ENDIF 420 295 421 ! 296 422 IF( nn_timing == 1 ) CALL timing_stop('trc_bc_read') … … 303 429 !!---------------------------------------------------------------------- 304 430 CONTAINS 431 432 SUBROUTINE trc_bc_init( ntrc ) ! Empty routine 433 INTEGER,INTENT(IN) :: ntrc ! number of tracers 434 WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 435 END SUBROUTINE trc_bc_init 436 305 437 SUBROUTINE trc_bc_read( kt ) ! Empty routine 306 438 WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r10251 r10253 9 9 !! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation 10 10 !! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models 11 !! 3.6 ! 2015-03 (T. Lovato) revision of code log info 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_top … … 72 73 IF( nn_timing == 1 ) CALL timing_start('trc_dta_init') 73 74 ! 75 IF( lwp ) THEN 76 WRITE(numout,*) ' ' 77 WRITE(numout,*) ' trc_dta_init : Tracers Initial Conditions (IC)' 78 WRITE(numout,*) ' ~~~~~~~~~~~ ' 79 ENDIF 80 ! 74 81 ! Initialisation 75 82 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 … … 77 84 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 78 85 IF( ierr0 > 0 ) THEN 79 CALL ctl_stop( 'trc_ nam: unable to allocate n_trc_index' ) ; RETURN86 CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' ) ; RETURN 80 87 ENDIF 81 88 nb_trcdta = 0 … … 97 104 REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data 98 105 READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 99 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp )106 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 100 107 101 108 REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 102 109 READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 103 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp )110 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 104 111 IF(lwm) WRITE ( numont, namtrc_dta ) 105 112 … … 109 116 clndta = TRIM( sn_trcdta(jn)%clvar ) 110 117 clntrc = TRIM( ctrcnm (jn) ) 118 if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra 111 119 zfact = rn_trfac(jn) 112 120 IF( clndta /= clntrc ) THEN 113 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :', &114 & ' the variable name in the data file : '//clndta// &115 & ' must be the same than the name of the passive tracer : '//clntrc//' ')121 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation ', & 122 & 'Input name of data file : '//TRIM(clndta)// & 123 & ' differs from that of tracer : '//TRIM(clntrc)//' ') 116 124 ENDIF 117 WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 118 & ' multiplicative factor : ', zfact 125 WRITE(numout,*) ' ' 126 WRITE(numout,'(a, i3,3a,e11.3)') ' Read IC file for tracer number :', & 127 & jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact 119 128 ENDIF 120 129 END DO … … 124 133 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 125 134 IF( ierr1 > 0 ) THEN 126 CALL ctl_stop( 'trc_dta_ini : unable to allocate sf_trcdta structure' ) ; RETURN135 CALL ctl_stop( 'trc_dta_init: unable to allocate sf_trcdta structure' ) ; RETURN 127 136 ENDIF 128 137 ! … … 135 144 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 136 145 IF( ierr2 + ierr3 > 0 ) THEN 137 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN146 CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' ) ; RETURN 138 147 ENDIF 139 148 ENDIF … … 141 150 ENDDO 142 151 ! ! fill sf_trcdta with slf_i and control print 143 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta ', 'Passive tracer data', 'namtrc' )152 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 144 153 ! 145 154 ENDIF -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r10251 r10253 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 … … 32 36 USE sbc_oce 33 37 USE trcice ! tracers in sea ice 38 USE trcbc, only : trc_bc_init ! generalized Boundary Conditions 34 39 35 40 IMPLICIT NONE … … 69 74 IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 70 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 <<<+++ 71 80 72 81 CALL top_alloc() ! allocate TOP arrays … … 101 110 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 102 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 <<<+++ 103 115 104 116 CALL trc_ice_ini ! Tracers in sea ice … … 110 122 ENDIF 111 123 124 ! Initialisation of tracers Initial Conditions 112 125 IF( ln_trcdta ) CALL trc_dta_init(jptra) 113 126 … … 144 157 ! 145 158 ENDIF 159 ! --->>> FABM 160 ! Initialisation of tracers Boundary Conditions - here so that you can use initial condition as boundary 161 !IF( lk_my_trc ) CALL trc_bc_init(jptra) 162 ! FABM <<<--- 163 ! FABM +++>>> 164 ! Initialisation of FABM diagnostics and tracer boundary conditions (so that you can use initial condition as boundary) 165 IF( lk_fabm ) THEN 166 wndm=0._wp !uninitiased field at this point 167 qsr=0._wp !uninitiased field at this point 168 CALL compute_fabm ! only needed to set-up diagnostics 169 CALL trc_bc_init(jptra) 170 ENDIF 171 ! FABM <<<+++ 146 172 147 173 tra(:,:,:,:) = 0._wp -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r10251 r10253 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 … … 34 37 PUBLIC trc_nam_run ! called in trcini 35 38 PUBLIC trc_nam ! called in trcini 39 PUBLIC trc_nam_dia 40 #if defined key_trdmxl_trc || defined key_trdtrc 41 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 42 & ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 43 & cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 44 #endif 36 45 37 46 !! * Substitutions … … 57 66 !!--------------------------------------------------------------------- 58 67 INTEGER :: jn ! dummy loop indice 68 #if defined key_trdmxl_trc || defined key_trdtrc 69 INTEGER :: ios 70 #endif 71 59 72 ! ! Parameters of the run 60 73 IF( .NOT. lk_offline ) CALL trc_nam_run … … 168 181 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 169 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 <<<+++ 170 189 ! 171 190 END SUBROUTINE trc_nam … … 187 206 188 207 189 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'208 IF(lwp) WRITE(numout,*) 'trc_nam_run : read the passive tracer namelists' 190 209 IF(lwp) WRITE(numout,*) '~~~~~~~' 191 210 … … 234 253 235 254 ! --- Namelist declarations --- ! 236 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 <<<+++ 237 261 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 238 262 … … 278 302 !! 279 303 !!--------------------------------------------------------------------- 280 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 281 !! 282 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 283 312 284 313 INTEGER :: ios ! Local integer output status for namelist read … … 286 315 !!--------------------------------------------------------------------- 287 316 IF(lwp) WRITE(numout,*) 288 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists'317 IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 289 318 IF(lwp) WRITE(numout,*) '~~~~~~~' 290 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 291 328 292 329 REWIND( numnat_ref ) ! Namelist namtrc in reference namelist : Passive tracer variables … … 304 341 ctrcun (jn) = TRIM( sn_tracer(jn)%clunit ) 305 342 ln_trc_ini(jn) = sn_tracer(jn)%llinit 343 ! --->>> FABM 344 !!#if defined key_my_trc 345 ! FABM <<<--- 346 ! +++>>> FABM 347 #if defined key_fabm 348 ! FABM <<<+++ 349 ln_trc_sbc(jn) = sn_tracer(jn)%llsbc 350 ln_trc_cbc(jn) = sn_tracer(jn)%llcbc 351 ln_trc_obc(jn) = sn_tracer(jn)%llobc 352 #endif 306 353 ln_trc_wri(jn) = sn_tracer(jn)%llsave 307 354 END DO 308 355 356 ! +++>>> FABM 357 if (lk_fabm) CALL trc_nam_fabm_override 358 ! FABM <<<+++ 309 359 END SUBROUTINE trc_nam_trc 310 360 … … 322 372 INTEGER :: ierr 323 373 #if defined key_trdmxl_trc || defined key_trdtrc 324 325 326 374 ! NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 375 ! & ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 376 ! & cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 327 377 #endif 328 378 NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio … … 397 447 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 398 448 !!====================================================================== 399 END MODULE 449 END MODULE trcnam -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r10251 r10253 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/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r10251 r10253 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) … … 75 81 76 82 !!====================================================================== 77 END MODULE 83 END MODULE trcsms -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r10251 r10253 32 32 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step 33 33 REAL(wp) :: rdt_sampl 34 INTEGER :: nb_rec_per_day s34 INTEGER :: nb_rec_per_day 35 35 INTEGER :: isecfst, iseclast 36 36 LOGICAL :: llnew … … 100 100 IF( lrst_trc ) CALL trc_rst_wri ( kt ) ! write tracer restart file 101 101 IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt ) ! trends: Mixed-layer 102 #if defined key_tracer_budget 103 !slwa tracer budget 104 IF( lk_iomput ) CALL trc_wri (kt, 2) 105 #endif 102 106 ! 103 107 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping … … 123 127 !! of diurnal cycle 124 128 !! 125 !! ** Method : store in TOP the qsr every hour ( or every time-step the latter129 !! ** Method : store in TOP the qsr every hour ( or every time-step if the latter 126 130 !! is greater than 1 hour ) and then, compute the mean with 127 131 !! a moving average over 24 hours. … … 134 138 IF( ln_cpl ) THEN 135 139 rdt_sampl = 86400. / ncpl_qsr_freq 136 nb_rec_per_day s= ncpl_qsr_freq140 nb_rec_per_day = ncpl_qsr_freq 137 141 ELSE 138 142 rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 139 nb_rec_per_day s= INT( 86400 / rdt_sampl )143 nb_rec_per_day = INT( 86400 / rdt_sampl ) 140 144 ENDIF 141 145 ! 142 146 IF( lwp ) THEN 143 147 WRITE(numout,*) 144 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day s148 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day 145 149 WRITE(numout,*) 146 150 ENDIF 147 151 ! 148 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 149 DO jn = 1, nb_rec_per_days 150 qsr_arr(:,:,jn) = qsr(:,:) 152 ! !* Restart: read in restart file 153 IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean', ldstop = .FALSE. ) > 0 ) THEN 154 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file' 155 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr 156 ELSE !* no restart: set from nit000 values 157 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values' 158 qsr_mean(:,:) = qsr(:,:) 159 ENDIF 160 ! 161 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 162 DO jn = 1, nb_rec_per_day 163 qsr_arr(:,:,jn) = qsr_mean(:,:) 151 164 ENDDO 152 qsr_mean(:,:) = qsr(:,:)153 165 ! 154 166 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step … … 163 175 & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 164 176 isecfst = iseclast 165 DO jn = 1, nb_rec_per_day s- 1177 DO jn = 1, nb_rec_per_day - 1 166 178 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 167 179 ENDDO 168 qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 169 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 170 ENDIF 171 ! 180 qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) 181 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day 182 ENDIF 183 ! 184 IF( lrst_trc ) THEN !* Write the mean of qsr in restart file 185 IF(lwp) WRITE(numout,*) 186 IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file kt =', kt 187 IF(lwp) WRITE(numout,*) '~~~~~~~' 188 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 189 ENDIF 190 ! 172 191 END SUBROUTINE trc_mean_qsr 173 192 -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r10251 r10253 20 20 #endif 21 21 #if defined key_zdfgls 22 USE zdfgls, ONLY: en22 ! USE zdfgls, ONLY: en 23 23 #endif 24 24 USE trabbl -
branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r10251 r10253 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 … … 32 35 CONTAINS 33 36 37 #if defined key_tracer_budget 38 SUBROUTINE trc_wri( kt , fl) !slwa 39 #else 34 40 SUBROUTINE trc_wri( kt ) 41 #endif 35 42 !!--------------------------------------------------------------------- 36 43 !! *** ROUTINE trc_wri *** … … 39 46 !!--------------------------------------------------------------------- 40 47 INTEGER, INTENT( in ) :: kt 48 ! +++>>>FABM 49 #if defined key_tracer_budget 50 INTEGER, INTENT( in ), OPTIONAL :: fl ! slwa 51 #endif 52 ! FABM <<<+++ 41 53 ! 42 54 INTEGER :: jn … … 59 71 IF( lk_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC 60 72 IF( lk_c14b ) CALL trc_wri_c14b ! surface fluxes of C14 61 IF( lk_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 73 ! +++>>>FABM 74 #if defined key_tracer_budget 75 IF( PRESENT(fl) ) THEN 76 IF( lk_fabm ) CALL trc_wri_fabm (kt, fl) ! MY_TRC tracers for budget 77 IF( lk_my_trc ) CALL trc_wri_my_trc (kt, fl) ! MY_TRC tracers for budget 78 ELSE 79 IF( lk_fabm ) CALL trc_wri_fabm (kt) ! FABM tracers for budget 80 IF( lk_my_trc ) CALL trc_wri_my_trc (kt) ! MY_TRC tracers 81 ENDIF 82 #else 83 IF( lk_fabm ) CALL trc_wri_fabm (kt) ! FABM tracers 84 IF( lk_my_trc ) CALL trc_wri_my_trc(kt) ! MY_TRC tracers 85 #endif 86 ! FABM <<<+++ 62 87 ! 88 63 89 IF( nn_timing == 1 ) CALL timing_stop('trc_wri') 64 90 !
Note: See TracChangeset
for help on using the changeset viewer.
