Changeset 777 for branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
- Timestamp:
- 2007-12-19T19:40:57+01:00 (16 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r774 r777 1 CCC $Header$ 2 SUBROUTINE trcexp(kt) 3 #if defined key_top && defined key_lobster 4 CCC--------------------------------------------------------------------- 5 CCC 6 CCC ROUTINE trcexp 7 CCC ****************** 8 CCC 9 CC 10 CC PURPOSE. 11 CC -------- 12 CC *TRCEXP* MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT 13 CC TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN 14 CC 15 CC METHOD. 16 CC ------- 17 CC IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO 18 CC NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE 19 CC KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. 20 CC THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER 21 CC COLUMN BELOW THE SURFACE LAYER. 22 CC 23 CC EXTERNALS. 24 CC ---------- 25 CC NONE. 26 CC 27 CC REFERENCE. 28 CC ---------- 29 CC 30 CC MODIFICATIONS: 31 CC -------------- 32 CC original : 1999 O. Aumont 33 CC modifications : 1999 C. Le Quere 34 CC additions : 01-05 (O. Aumont, E. Kestenare): 35 CC add sediment computations 36 CC : 05-06 (AS. Kremeur) new temporal integration for sedpoc 37 CC --------------------------------------------------------------------- 38 c ------ 39 CC parameters and commons 40 CC ====================== 41 CDIR$ NOLIST 42 USE oce_trc 43 USE trp_trc 44 USE sms 45 USE lbclnk 46 USE trc 47 USE trctrp_lec 1 MODULE trcexp 2 !!====================================================================== 3 !! *** MODULE p4sed *** 4 !! TOP : PISCES Compute loss of organic matter in the sediments 5 !!====================================================================== 6 !! History : - ! 1999 (O. Aumont, C. Le Quere) original code 7 !! - ! 2001-05 (O. Aumont, E. Kestenare) add sediment computations 8 !! 1.0 ! 2005-06 (A.-S. Kremeur) new temporal integration for sedpoc 9 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 10 !!---------------------------------------------------------------------- 11 #if defined key_lobster 12 !!---------------------------------------------------------------------- 13 !! 'key_lobster' LOBSTER bio-model 14 !!---------------------------------------------------------------------- 15 !! trc_exp : Compute loss of organic matter in the sediments 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! 18 USE trp_trc 19 USE sms 20 USE lbclnk 21 USE trc 22 USE trctrp_lec 48 23 49 IMPLICIT NONE 50 CDIR$ LIST 51 CC---------------------------------------------------------------------- 52 CC local declarations 53 CC ================== 54 C 55 INTEGER kt 56 INTEGER ji, jj, jk, zkbot(jpi,jpj) 57 REAL zwork(jpi,jpj), zgeolpoc, zfact 58 CC---------------------------------------------------------------------- 59 CC statement functions 60 CC =================== 61 CDIR$ NOLIST 62 #include "domzgr_substitute.h90" 63 CDIR$ LIST 64 C 65 C VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 66 C POC IN THE WATER COLUMN 67 C (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT 68 C LAYERS IS DETERMINED BY DMIN3 DEFINED IN common.passivetrc.*.h 69 C ---------------------------------------------------------------------- 70 C 71 C 72 DO jk = 1,jpkm1 73 DO jj = 2,jpjm1 74 DO ji = 2,jpim1 75 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3)+ 76 & (1./fse3t(ji,jj,jk))* 77 & dmin3(ji,jj,jk) *fbod(ji,jj) 78 ENDDO 79 ENDDO 80 ENDDO 81 C 82 C Find the last level of the water column 83 C Compute fluxes due to sinking particles (slow) 84 C 85 zkbot = jpk 86 zwork = 0. 87 C 88 C 89 DO jk = 1,jpkm1 90 DO jj = 2,jpjm1 91 DO ji = 2,jpim1 24 IMPLICIT NONE 25 PRIVATE 26 27 PUBLIC trc_exp ! called in p4zprg.F90 28 29 !!* Substitution 30 # include "domzgr_substitute.h90" 31 !!---------------------------------------------------------------------- 32 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 33 !! $Id:$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 35 !!---------------------------------------------------------------------- 36 37 CONTAINS 38 39 SUBROUTINE trc_exp( kt ) 40 !!--------------------------------------------------------------------- 41 !! *** ROUTINE trc_exp *** 42 !! 43 !! ** Purpose : MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT 44 !! TISSUE'') AND ITS DISTRIBUTION IN WATER COLUMN 45 !! 46 !! ** Method : - IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO 47 !! NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE 48 !! KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. 49 !! THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER 50 !! COLUMN BELOW THE SURFACE LAYER. 51 !!--------------------------------------------------------------------- 52 INTEGER, INTENT( in ) :: kt ! ocean time-step index 53 !! 54 INTEGER :: ji, jj, jk 55 REAL(wp) :: zgeolpoc, zfact 56 INTEGER , DIMENSION(jpi,jpj) :: ikbot 57 REAL(wp), DIMENSION(jpi,jpj) :: zwork 58 !!--------------------------------------------------------------------- 59 60 IF( kt == nit000 ) THEN 61 IF(lwp) WRITE(numout,*) 62 IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' 63 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 64 ENDIF 65 66 ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 67 ! POC IN THE WATER COLUMN 68 ! (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT 69 ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN common.passivetrc.*.h 70 ! ---------------------------------------------------------------------- 71 72 DO jk = 1, jpkm1 73 DO jj = 2, jpjm1 74 DO ji = 2, jpim1 75 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) & 76 & + (1./fse3t(ji,jj,jk)) * dmin3(ji,jj,jk) * fbod(ji,jj) 77 END DO 78 END DO 79 END DO 80 81 ! Find the last level of the water column 82 ! Compute fluxes due to sinking particles (slow) 92 83 93 IF ( tmask(ji,jj,jk) .eq. 1 .and. 94 . tmask(ji,jj,jk+1). eq. 0 ) THEN 95 zkbot(ji,jj) = jk 84 ikbot(:,:) = jpk 85 zwork(:,:) = 0.e0 86 87 !!gm ikbot already exist in opa... 88 DO jk = 1, jpkm1 89 DO jj = 2, jpjm1 90 DO ji = 2, jpim1 91 IF( tmask(ji,jj,jk) == 1 .AND. tmask(ji,jj,jk+1) == 0 ) THEN 92 ikbot(ji,jj) = jk 96 93 zwork(ji,jj) = vsed * trn(ji,jj,jk,jpdet) 97 ENDIF 98 99 ENDDO 100 ENDDO 101 ENDDO 102 C 103 C Initialization 104 zgeolpoc = 0. 94 ENDIF 95 END DO 96 END DO 97 END DO 105 98 106 C Release of nutrients from the "simple" sediment 107 C 108 DO jj = 2,jpjm1 109 DO ji = 2,jpim1 110 tra(ji,jj,zkbot(ji,jj),jpno3) = 111 . tra(ji,jj,zkbot(ji,jj),jpno3) + 112 . sedlam*sedpocn(ji,jj)/fse3t(ji,jj,zkbot(ji,jj)) 99 zgeolpoc = 0.e0 ! Initialization 113 100 114 C Deposition of organic matter in the sediment 115 C 116 zgeolpoc = zgeolpoc + sedlostpoc*sedpocn(ji,jj)* 117 . e1t(ji,jj)*e2t(ji,jj) 101 ! Release of nutrients from the "simple" sediment 102 DO jj = 2, jpjm1 103 DO ji = 2, jpim1 104 tra(ji,jj,ikbot(ji,jj),jpno3) = tra(ji,jj,ikbot(ji,jj),jpno3) & 105 & + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot(ji,jj)) 118 106 119 sedpoca(ji,jj) = zwork(ji,jj)*rdt + 120 . dminl(ji,jj)*fbod(ji,jj)*rdt - 121 . sedlam*sedpocn(ji,jj)*rdt - 122 . sedlostpoc*sedpocn(ji,jj)*rdt 123 C 124 ENDDO 125 ENDDO 126 C 127 DO jj = 2,jpjm1 128 DO ji = 2,jpim1 129 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc* 130 . cmask(ji,jj)/areacot/fse3t(ji,jj,1) 131 ENDDO 132 ENDDO 107 ! Deposition of organic matter in the sediment 108 zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj) 133 109 134 CALL lbc_lnk( sedpocn, 'T', 1. ) 110 !!gm factorisationof rdt just bellow... 111 sedpoca(ji,jj) = zwork(ji,jj) * rdt + dminl(ji,jj) * fbod(ji,jj) * rdt & 112 & - sedlam * sedpocn(ji,jj) * rdt - sedlostpoc * sedpocn(ji,jj) * rdt 113 114 END DO 115 END DO 116 117 DO jj = 2,jpjm1 118 DO ji = 2,jpim1 119 tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 120 END DO 121 END DO 122 123 CALL lbc_lnk( sedpocn, 'T', 1. ) 135 124 136 C Oa & Ek: diagnostics depending on jpdia2d 137 C left as example 138 # if defined key_trc_diaadd 139 do jj=1,jpj 140 do ji=1,jpi 141 trc2d(ji,jj,19)=sedpocn(ji,jj) 142 end do 143 end do 144 # endif 125 ! Oa & Ek: diagnostics depending on jpdia2d ! left as example 126 # if defined key_trc_diaadd 127 trc2d(:,:,19) = sedpocn(:,:) 128 # endif 145 129 146 c ! 1. Leap-frog scheme (only in explicit case, otherwise the 147 c ! ------------------- time stepping is already done in trczdf) 148 IF(l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd)) THEN 149 zfact = 2. * rdttra(jk) * FLOAT(ndttrc) 150 IF( neuler == 0 .AND. kt == nittrc000 ) 151 . zfact = rdttra(jk) * FLOAT(ndttrc) 152 sedpoca(:,:) = ( sedpocb(:,:) + zfact * sedpoca(:,:) ) 130 ! Leap-frog scheme (only in explicit case, otherwise the 131 ! ---------------- time stepping is already done in trczdf) 132 IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 133 zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 134 IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc) 135 sedpoca(:,:) = sedpocb(:,:) + zfact * sedpoca(:,:) 153 136 ENDIF 154 137 155 138 156 c ! 2.Time filter and swap of arrays157 c ! ---------------------------------158 IF ( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN159 160 161 139 ! Time filter and swap of arrays 140 ! ------------------------------ 141 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ! centred or tvd scheme 142 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 143 DO jj = 1, jpj 144 DO ji = 1, jpi 162 145 sedpocb(ji,jj) = sedpocn(ji,jj) 163 146 sedpocn(ji,jj) = sedpoca(ji,jj) 164 sedpoca(ji,jj) = 0. 165 166 147 sedpoca(ji,jj) = 0.e0 148 END DO 149 END DO 167 150 ELSE 168 151 DO jj = 1, jpj 169 152 DO ji = 1, jpi 170 sedpocb(ji,jj) = atfp*(sedpocb(ji,jj)+sedpoca(ji,jj))171 . + atfp1 *sedpocn(ji,jj)172 sedpocn(ji,jj) = sedpoca(ji,jj)173 sedpoca(ji,jj) = 0.153 sedpocb(ji,jj) = atfp * ( sedpocb(ji,jj) + sedpoca(ji,jj) ) & 154 & + atfp1 * sedpocn(ji,jj) 155 sedpocn(ji,jj) = sedpoca(ji,jj) 156 sedpoca(ji,jj) = 0.e0 174 157 END DO 175 158 END DO 176 159 ENDIF 177 178 ELSE 179 c ! case of smolar scheme or muscl 180 DO jj = 1, jpj 181 DO ji = 1, jpi 182 sedpocb(ji,jj) = sedpoca(ji,jj) 183 sedpocn(ji,jj) = sedpoca(ji,jj) 184 sedpoca(ji,jj) = 0. 185 END DO 186 END DO 187 160 ELSE ! case of smolar scheme or muscl 161 sedpocb(:,:) = sedpoca(:,:) 162 sedpocn(:,:) = sedpoca(:,:) 163 sedpoca(:,:) = 0.e0 188 164 ENDIF 165 ! 166 END SUBROUTINE trc_exp 189 167 190 #endif 191 RETURN 192 END 168 #else 169 !!====================================================================== 170 !! Dummy module : No PISCES bio-model 171 !!====================================================================== 172 CONTAINS 173 SUBROUTINE trc_exp( kt ) ! Empty routine 174 INTEGER, INTENT( in ) :: kt 175 WRITE(*,*) 'trc_exp: You should not have seen this print! error?', kt 176 END SUBROUTINE trc_exp 177 #endif 178 179 !!====================================================================== 180 END MODULE trcexp
Note: See TracChangeset
for help on using the changeset viewer.
