[699] | 1 | CC $Id$ |
---|
[186] | 2 | CDIR$ LIST |
---|
| 3 | SUBROUTINE trcopt(kt) |
---|
| 4 | CCC--------------------------------------------------------------------- |
---|
| 5 | CCC |
---|
| 6 | CCC ROUTINE trcopt |
---|
| 7 | CCC ******************* |
---|
| 8 | CCC |
---|
| 9 | CCC PURPOSE : |
---|
| 10 | CCC --------- |
---|
| 11 | CCC computes the light propagation in the water column |
---|
| 12 | CCC and the euphotic layer depth |
---|
| 13 | CCC |
---|
| 14 | CCC |
---|
| 15 | CC METHOD : |
---|
| 16 | CC ------- |
---|
| 17 | CC |
---|
| 18 | CC multitasked on vertical slab (jj-loop) |
---|
| 19 | CC local par is computed in w layers using light propagation |
---|
| 20 | CC mean par in t layers are computed by integration |
---|
| 21 | CC |
---|
| 22 | CC |
---|
| 23 | CC INPUT : |
---|
| 24 | CC ----- |
---|
| 25 | CC argument |
---|
| 26 | CC ktask : task identificator |
---|
| 27 | CC kt : time step |
---|
| 28 | CC COMMON |
---|
| 29 | CC /comcoo/ : orthogonal curvilinear coordinates |
---|
| 30 | CC and scale factors |
---|
| 31 | CC depths |
---|
| 32 | CC /comzdf/ : avt vertical eddy diffusivity |
---|
| 33 | CC /comqsr/ : solar radiation |
---|
| 34 | CC /comtsk/ : multitasking |
---|
| 35 | CC /cotopt/ : optical parameters |
---|
| 36 | CC /cotbio/ : biological parameters |
---|
| 37 | CC |
---|
| 38 | CC OUTPUT : |
---|
| 39 | CC ------ |
---|
| 40 | CC COMMON |
---|
| 41 | CC /cotopt/ : optical parameters |
---|
| 42 | CC |
---|
| 43 | CC WORKSPACE : |
---|
| 44 | CC --------- |
---|
| 45 | CC local zparr : red compound of par |
---|
| 46 | CC zparg : green compound of par |
---|
| 47 | CC zpar0m : irradiance just below the surface |
---|
| 48 | CC zpar100 : irradiance at euphotic layer depth |
---|
| 49 | CC zkr : total absorption coefficient in red |
---|
| 50 | CC zkg : total absorption coefficient in green |
---|
| 51 | CC zpig : total pigment |
---|
| 52 | CC imaske : euphotic layer mask |
---|
| 53 | CC itabe : euphotic layer last k index |
---|
| 54 | CC |
---|
| 55 | CC COMMON |
---|
| 56 | CC |
---|
| 57 | CC EXTERNAL : no |
---|
| 58 | CC -------- |
---|
| 59 | CC |
---|
| 60 | CC REFERENCES : no |
---|
| 61 | CC ---------- |
---|
| 62 | CC |
---|
| 63 | CC MODIFICATIONS: |
---|
| 64 | CC -------------- |
---|
| 65 | CC original : 95-05 (M. Levy) |
---|
| 66 | CC 99-09 (J-M Andre & M. Levy) |
---|
| 67 | CC modifications : 99-11 (C. Menkes M.A. Foujols) itabe initial. |
---|
| 68 | CC modifications : 00-02 (M.A. Foujols) change x**y par exp(y*log(x)) |
---|
| 69 | CC---------------------------------------------------------------------- |
---|
| 70 | CDIR$ NOLIST |
---|
| 71 | |
---|
| 72 | USE oce_trc |
---|
| 73 | USE trp_trc |
---|
| 74 | USE sms |
---|
| 75 | IMPLICIT NONE |
---|
| 76 | CDIR$ LIST |
---|
| 77 | CCC--------------------------------------------------------------------- |
---|
| 78 | CCC OPA8, LODYC (11/96) |
---|
| 79 | CCC--------------------------------------------------------------------- |
---|
| 80 | CC---------------------------------------------------------------------- |
---|
| 81 | CC local declarations |
---|
| 82 | CC ================== |
---|
| 83 | INTEGER kt |
---|
| 84 | |
---|
[339] | 85 | #if defined key_passivetrc && defined key_trc_lobster1 |
---|
[186] | 86 | C |
---|
| 87 | INTEGER ji,jj,jk,jn,in |
---|
| 88 | |
---|
| 89 | REAL zpig,zkr,zkg |
---|
| 90 | |
---|
| 91 | REAL zparr(jpi,jpk),zparg(jpi,jpk) |
---|
| 92 | REAL zpar0m(jpi),zpar100(jpi) |
---|
| 93 | INTEGER itabe(jpi),imaske(jpi,jpk) |
---|
| 94 | CC---------------------------------------------------------------------- |
---|
| 95 | CC statement functions |
---|
| 96 | CC =================== |
---|
| 97 | CDIR$ NOLIST |
---|
| 98 | #include "domzgr_substitute.h90" |
---|
| 99 | CDIR$ LIST |
---|
| 100 | CCC--------------------------------------------------------------------- |
---|
| 101 | CCC OPA8, LODYC (15/11/96) |
---|
| 102 | CCC--------------------------------------------------------------------- |
---|
| 103 | C |
---|
| 104 | C |
---|
| 105 | C find Phytoplancton index - test CTRCNM |
---|
| 106 | C |
---|
| 107 | in=0 |
---|
| 108 | DO jn = 1,jptra |
---|
| 109 | IF ((ctrcnm(jn) .EQ. 'PHY') .OR. |
---|
| 110 | $ (ctrcnm(jn) .EQ. 'PHYTO') ) THEN |
---|
| 111 | |
---|
| 112 | in = jn |
---|
| 113 | END IF |
---|
| 114 | END DO |
---|
| 115 | IF (in.eq.0) THEN |
---|
| 116 | IF (lwp) THEN |
---|
| 117 | WRITE (numout,*) |
---|
| 118 | $ ' Problem trcopt : PHY or PHYTO not found ' |
---|
| 119 | CALL FLUSH(numout) |
---|
| 120 | ENDIF |
---|
| 121 | ENDIF |
---|
| 122 | C |
---|
| 123 | C vertical slab |
---|
| 124 | C =============== |
---|
| 125 | C |
---|
| 126 | DO 1000 jj = 1,jpj |
---|
| 127 | C |
---|
| 128 | C |
---|
| 129 | C 1. determination of surface irradiance |
---|
| 130 | C -------------------------------------- |
---|
| 131 | C |
---|
| 132 | C |
---|
| 133 | DO ji = 1,jpi |
---|
| 134 | zpar0m(ji) = qsr(ji,jj)*0.43 |
---|
| 135 | zpar100(ji) = zpar0m(ji)*0.01 |
---|
| 136 | xpar(ji,jj,1) = zpar0m(ji) |
---|
| 137 | zparr(ji,1) = 0.5* zpar0m(ji) |
---|
| 138 | zparg(ji,1) = 0.5* zpar0m(ji) |
---|
| 139 | END DO |
---|
| 140 | |
---|
| 141 | C |
---|
| 142 | C 2. determination of xpar |
---|
| 143 | C ------------------------ |
---|
| 144 | C |
---|
| 145 | C determination of local par in w levels |
---|
| 146 | DO jk = 2,jpk |
---|
| 147 | DO ji = 1,jpi |
---|
| 148 | zpig = max(tiny(0.),trn(ji,jj,jk - 1,in))*12*redf/rcchl/rpig |
---|
| 149 | zkr = xkr0 + xkrp*exp(xlr*log(zpig)) |
---|
| 150 | zkg = xkg0 + xkgp*exp(xlg*log(zpig)) |
---|
| 151 | zparr(ji,jk) = zparr(ji,jk - 1) |
---|
| 152 | $ *exp( -zkr*fse3t(ji,jj,jk - 1) ) |
---|
| 153 | zparg(ji,jk) = zparg(ji,jk - 1) |
---|
| 154 | $ *exp( -zkg*fse3t(ji,jj,jk - 1) ) |
---|
| 155 | END DO |
---|
| 156 | END DO |
---|
| 157 | |
---|
| 158 | C |
---|
| 159 | C mean par in t levels |
---|
| 160 | DO jk = 1,jpkm1 |
---|
| 161 | DO ji = 1,jpi |
---|
| 162 | zpig = max(tiny(0.),trn(ji,jj,jk ,in))*12*redf/rcchl/rpig |
---|
| 163 | zkr = xkr0 + xkrp*exp(xlr*log(zpig)) |
---|
| 164 | zkg = xkg0 + xkgp*exp(xlg*log(zpig)) |
---|
| 165 | zparr(ji,jk) = zparr(ji,jk) / zkr / fse3t(ji,jj,jk) |
---|
| 166 | $ * ( 1 - exp( -zkr*fse3t(ji,jj,jk) ) ) |
---|
| 167 | zparg(ji,jk) = zparg(ji,jk) / zkg / fse3t(ji,jj,jk) |
---|
| 168 | $ * ( 1 - exp( -zkg*fse3t(ji,jj,jk) ) ) |
---|
| 169 | xpar(ji,jj,jk) = max(zparr(ji,jk) |
---|
| 170 | $ + zparg(ji,jk),1.e-15) |
---|
| 171 | END DO |
---|
| 172 | END DO |
---|
| 173 | C |
---|
| 174 | C |
---|
| 175 | C 4. determination of euphotic layer depth |
---|
| 176 | C ---------------------------------------- |
---|
| 177 | C |
---|
| 178 | C imaske equal 1 in the euphotic layer, and 0 without |
---|
| 179 | C |
---|
| 180 | DO jk = 1,jpk |
---|
| 181 | DO ji = 1,jpi |
---|
| 182 | imaske(ji,jk) = 0 |
---|
| 183 | IF (xpar(ji,jj,jk) .GE. zpar100(ji)) imaske(ji,jk) = 1 |
---|
| 184 | END DO |
---|
| 185 | END DO |
---|
| 186 | C |
---|
| 187 | DO ji = 1,jpi |
---|
| 188 | itabe(ji) = 0 |
---|
| 189 | END DO |
---|
| 190 | C |
---|
| 191 | DO jk = 1,jpk |
---|
| 192 | DO ji = 1,jpi |
---|
| 193 | itabe(ji) = itabe(ji) + imaske(ji,jk) |
---|
| 194 | END DO |
---|
| 195 | END DO |
---|
| 196 | C |
---|
| 197 | DO ji = 1,jpi |
---|
| 198 | itabe(ji) = max(1,itabe(ji)) |
---|
| 199 | xze(ji,jj) = fsdepw(ji,jj,itabe(ji) + 1) |
---|
| 200 | END DO |
---|
| 201 | C |
---|
| 202 | C |
---|
| 203 | C END of slab |
---|
| 204 | C =========== |
---|
| 205 | C |
---|
| 206 | 1000 CONTINUE |
---|
| 207 | C |
---|
| 208 | #else |
---|
| 209 | C |
---|
| 210 | C no passive tracers |
---|
| 211 | C |
---|
| 212 | #endif |
---|
| 213 | C |
---|
| 214 | RETURN |
---|
| 215 | END |
---|