Changeset 858 for branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zmicro.F90
- Timestamp:
- 2008-03-13T15:17:04+01:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r775 r858 16 16 USE trp_trc ! 17 17 USE sms ! 18 USE prtctl_trc 18 19 19 20 IMPLICIT NONE … … 40 41 !! ** Method : - ??? 41 42 !!--------------------------------------------------------------------- 42 INTEGER :: ji, jj, jk 43 REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 44 REAL(wp) :: zgraze , zdenom , zdenom2 45 REAL(wp) :: zfact , zstep , zinano , zidiat, zipoc 43 INTEGER :: ji, jj, jk 44 REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 45 REAL(wp) :: zgraze , zdenom , zdenom2 46 REAL(wp) :: zfact , zstep , zinano , zidiat, zipoc 47 REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 48 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrespz,ztortz 49 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazp, zgrazm, zgrazsd 50 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 51 CHARACTER (len=25) :: charout 52 46 53 !!--------------------------------------------------------------------- 47 54 … … 62 69 ! ------------------------------------- 63 70 64 respz(ji,jj,jk) = resrat * zfact * ( 1.+ 3.* nitrfac(ji,jj,jk) ) &71 zrespz(ji,jj,jk) = resrat * zfact * ( 1.+ 3.* nitrfac(ji,jj,jk) ) & 65 72 & * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 66 73 … … 69 76 ! mimic predation. 70 77 ! --------------------------------------------------------------- 71 72 tortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 73 74 75 76 END DO 77 78 DO jk = 1, jpkm179 DO jj = 1, jpj80 DO ji = 1, jpi81 78 ztortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 79 80 END DO 81 END DO 82 END DO 83 84 85 86 DO jk = 1,jpkm1 87 DO jj = 1,jpj 88 DO ji = 1,jpi 82 89 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 83 90 zcompadi2 = MIN( zcompadi, 5.e-7 ) 84 91 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 85 92 zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 86 87 ! Microzooplankton grazing88 ! ------------------------93 94 ! Microzooplankton grazing 95 ! ------------------------ 89 96 zdenom2 = 1./ ( zprefp * zcompaph + zprefc * zcompapoc + zprefd * zcompadi2 + rtrn ) 90 97 … … 101 108 zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 102 109 103 grazp (ji,jj,jk) = zgraze * zinano * zcompaph * zdenom 104 grazm (ji,jj,jk) = zgraze * zipoc * zcompapoc * zdenom 105 grazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 106 107 grazpf (ji,jj,jk) = grazp (ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 108 109 grazpch(ji,jj,jk) = grazp (ji,jj,jk) * trn(ji,jj,jk,jpnch) / (trn(ji,jj,jk,jpphy) + rtrn) 110 111 grazmf (ji,jj,jk) = grazm (ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 112 113 grazsf (ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 114 115 grazss (ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) / (trn(ji,jj,jk,jpdia) + rtrn) 116 117 grazsch(ji,jj,jk) = grazsd(ji,jj,jk) * trn(ji,jj,jk,jpdch) / (trn(ji,jj,jk,jpdia) + rtrn) 118 119 END DO 120 END DO 121 END DO 110 zgrazp(ji,jj,jk) = zgraze * zinano * zcompaph * zdenom 111 zgrazm(ji,jj,jk) = zgraze * zipoc * zcompapoc * zdenom 112 zgrazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 113 114 zgrazpf (ji,jj,jk) = zgrazp(ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 115 zgrazmf(ji,jj,jk) = zgrazm(ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 116 zgrazsf(ji,jj,jk) = zgrazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 117 118 END DO 119 END DO 120 END DO 121 122 123 DO jk = 1,jpkm1 124 DO jj = 1,jpj 125 DO ji = 1,jpi 126 ! Various remineralization and excretion terms 127 ! -------------------------------------------- 128 129 zgrarem = ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk) ) & 130 & * ( 1.- epsher - unass ) 131 zgrafer = ( zgrazpf(ji,jj,jk) + zgrazsf(ji,jj,jk) + zgrazmf(ji,jj,jk) ) & 132 & * ( 1.- epsher - unass ) + epsher * & 133 & ( zgrazm(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) /(trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 134 & + zgrazp(ji,jj,jk) * MAX((trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 135 & + zgrazsd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 ) ) 136 zgrapoc = ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk) ) * unass 137 138 ! Update of the TRA arrays 139 ! ------------------------ 140 141 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem * sigma1 142 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem * sigma1 143 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem * (1.-sigma1) 144 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 145 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 146 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 147 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 148 #if defined key_kriest 149 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ndiat 150 #endif 151 END DO 152 END DO 153 END DO 154 155 ! 156 ! Update the arrays TRA which contain the biological sources and sinks 157 ! -------------------------------------------------------------------- 122 158 123 159 DO jk = 1, jpkm1 … … 125 161 DO ji = 1, jpi 126 162 127 ! Various remineralization and excretion terms 128 ! -------------------------------------------- 129 130 grarem(ji,jj,jk) = ( grazp(ji,jj,jk) + grazm (ji,jj,jk) & 131 & + grazsd(ji,jj,jk) ) * ( 1.- epsher - unass ) 132 133 grafer(ji,jj,jk) = ( grazpf(ji,jj,jk) + grazsf(ji,jj,jk) & 134 & + grazmf(ji,jj,jk) ) * ( 1.- epsher - unass ) & 135 & + ( grazm (ji,jj,jk) * MAX( (trn(ji,jj,jk,jpsfe) / & 136 & (trn(ji,jj,jk,jppoc) + rtrn) - ferat3), 0.e0 ) & 137 & + grazp (ji,jj,jk) * MAX( (trn(ji,jj,jk,jpnfe) / & 138 & (trn(ji,jj,jk,jpphy) + rtrn) - ferat3), 0.e0 ) & 139 & + grazsd(ji,jj,jk) * MAX( (trn(ji,jj,jk,jpdfe) / & 140 & (trn(ji,jj,jk,jpdia) + rtrn) - ferat3), 0.e0 ) ) * epsher 141 142 grapoc(ji,jj,jk) = ( grazp(ji,jj,jk) + grazm(ji,jj,jk) + grazsd(ji,jj,jk) ) * unass 143 163 zmortz = ztortz(ji,jj,jk) + zrespz(ji,jj,jk) 164 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz & 165 & + epsher * ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)) 166 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp(ji,jj,jk) 167 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd(ji,jj,jk) 168 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp(ji,jj,jk) & 169 & * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 170 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd(ji,jj,jk) & 171 & * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 172 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd(ji,jj,jk) & 173 & * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 174 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd(ji,jj,jk) & 175 & * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 176 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf(ji,jj,jk) 177 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf(ji,jj,jk) 178 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm(ji,jj,jk) 179 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz & 180 & + unass * ( zgrazpf(ji,jj,jk) + zgrazsf (ji,jj,jk)) & 181 & - (1.-unass) * zgrazmf(ji,jj,jk) 182 zprcaca = xfracal(ji,jj,jk) * part * unass * zgrazp(ji,jj,jk) 183 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 184 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal)- 2. * zprcaca 185 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 186 #if defined key_kriest 187 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm(ji,jj,jk) ) * xkr_ndiat 188 #endif 144 189 END DO 145 190 END DO 146 191 END DO 147 192 ! 193 IF(ln_ctl) THEN ! print mean trends (used for debugging) 194 WRITE(charout, FMT="('micro')") 195 CALL prt_ctl_trc_info(charout) 196 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 197 ENDIF 198 148 199 END SUBROUTINE p4z_micro 149 200
Note: See TracChangeset
for help on using the changeset viewer.
