[341] | 1 | |
---|
[719] | 2 | CCC $Header$ |
---|
[341] | 3 | CCC TOP 1.0 , LOCEAN-IPSL (2005) |
---|
| 4 | C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt |
---|
| 5 | C --------------------------------------------------------------------------- |
---|
[186] | 6 | SUBROUTINE p4zsink2(wstmp,sinktemp,jn) |
---|
| 7 | CDIR$ LIST |
---|
| 8 | #if defined key_passivetrc && defined key_trc_pisces |
---|
| 9 | !!! |
---|
| 10 | !!! p4zsink2 : PISCES model |
---|
| 11 | !!! *********************** |
---|
| 12 | !!! |
---|
| 13 | !! |
---|
| 14 | !! PURPOSE : |
---|
| 15 | !! --------- |
---|
| 16 | !! Compute the sedimentation terms for the various sinking |
---|
| 17 | !! particles. The scheme used to compute the trends is based |
---|
| 18 | !! on MUSCL. |
---|
| 19 | !! |
---|
| 20 | !! METHOD : |
---|
| 21 | !! ------- |
---|
| 22 | !! this ROUTINE compute not exactly the advection but the |
---|
| 23 | !! transport term, i.e. div(u*tra). |
---|
| 24 | !! |
---|
| 25 | !! |
---|
| 26 | !! REFERENCES : |
---|
| 27 | !! ---------- |
---|
| 28 | !! |
---|
| 29 | !! References : |
---|
| 30 | !! Estubier, A., and M. Levy, Notes Techn. Pole de Modelisation |
---|
| 31 | !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) |
---|
| 32 | !! |
---|
| 33 | !! |
---|
| 34 | !! MODIFICATIONS: |
---|
| 35 | !! -------------- |
---|
| 36 | !! original : 06-00 (A.Estublier) |
---|
| 37 | !! modifications : 2004 (O. Aumont) |
---|
| 38 | !! |
---|
| 39 | !!---------------------------------------------------------------------- |
---|
| 40 | CC ---------------------------------------------------------------- |
---|
| 41 | CC parameters and commons |
---|
| 42 | CC ====================== |
---|
| 43 | CDIR$ NOLIST |
---|
| 44 | USE oce_trc |
---|
| 45 | USE trp_trc |
---|
| 46 | USE sms |
---|
| 47 | IMPLICIT NONE |
---|
[339] | 48 | #include "domzgr_substitute.h90" |
---|
[186] | 49 | CDIR$ LIST |
---|
| 50 | CC----------------------------------------------------------------- |
---|
| 51 | CC local declarations |
---|
| 52 | CC ================== |
---|
| 53 | C |
---|
| 54 | INTEGER ji,jj,jk,jn |
---|
| 55 | REAL ztraz(jpi,jpj,jpk),zakz(jpi,jpj,jpk) |
---|
| 56 | REAL zkz(jpi,jpj,jpk) |
---|
| 57 | REAL zigma,zew,zstep,zign |
---|
| 58 | REAL wstmp(jpi,jpj,jpk),sinktemp(jpi,jpj,jpk) |
---|
| 59 | REAL wstmp2(jpi,jpj,jpk) |
---|
| 60 | |
---|
| 61 | !!!--------------------------------------------------------------------- |
---|
| 62 | !!! OPA8, LODYC (01/00) |
---|
| 63 | !!!--------------------------------------------------------------------- |
---|
| 64 | ! 1. Initialization |
---|
| 65 | ! -------------- |
---|
| 66 | |
---|
[617] | 67 | zstep = rfact2 |
---|
[186] | 68 | |
---|
| 69 | ztraz = 0 |
---|
| 70 | zkz = 0 |
---|
| 71 | zakz = 0. |
---|
| 72 | |
---|
| 73 | do jk=1,jpk-1 |
---|
| 74 | wstmp2(:,:,jk+1)=-wstmp(:,:,jk)/rjjss*tmask(:,:,jk+1) |
---|
| 75 | # if defined key_off_degrad |
---|
| 76 | & *facvol(:,:,jk) |
---|
| 77 | # endif |
---|
| 78 | end do |
---|
| 79 | |
---|
| 80 | wstmp2(:,:,1)=0. |
---|
| 81 | ! |
---|
| 82 | ! 3. Vertical advective flux |
---|
| 83 | !------------------------------- |
---|
| 84 | ! ... first guess of the slopes |
---|
| 85 | ! ... interior values |
---|
| 86 | ! |
---|
| 87 | DO jk=2,jpkm1 |
---|
| 88 | ztraz(:,:,jk) = (trn(:,:,jk-1,jn) - trn(:,:,jk,jn)) |
---|
| 89 | $ *tmask(:,:,jk) |
---|
| 90 | ENDDO |
---|
| 91 | ! |
---|
| 92 | ! slopes |
---|
| 93 | ! |
---|
| 94 | DO jk=2,jpkm1 |
---|
| 95 | DO jj = 1,jpj |
---|
| 96 | DO ji = 1, jpi |
---|
| 97 | zign = 0.5*(sign(1.,ztraz(ji,jj,jk)*ztraz(ji,jj,jk+1))+1) |
---|
| 98 | zakz(ji,jj,jk) = 0.5*(ztraz(ji,jj,jk) |
---|
| 99 | $ +ztraz(ji,jj,jk+1))*zign |
---|
| 100 | ENDDO |
---|
| 101 | ENDDO |
---|
| 102 | ENDDO |
---|
| 103 | ! |
---|
| 104 | ! Slopes limitation |
---|
| 105 | ! |
---|
| 106 | DO jk=2,jpkm1 |
---|
| 107 | DO jj = 1,jpj |
---|
| 108 | DO ji = 1,jpi |
---|
| 109 | zakz(ji,jj,jk) = sign(1.,zakz(ji,jj,jk)) * |
---|
| 110 | $ min(abs(zakz(ji,jj,jk)), |
---|
| 111 | $ 2.*abs(ztraz(ji,jj,jk+1)), |
---|
| 112 | $ 2.*abs(ztraz(ji,jj,jk))) |
---|
| 113 | ENDDO |
---|
| 114 | ENDDO |
---|
| 115 | ENDDO |
---|
| 116 | |
---|
| 117 | ! vertical advective flux |
---|
| 118 | DO jk=1,jpkm1 |
---|
| 119 | DO jj = 1,jpj |
---|
| 120 | DO ji = 1, jpi |
---|
| 121 | zigma = wstmp2(ji,jj,jk+1)*zstep/fse3w(ji,jj,jk+1) |
---|
| 122 | zew = wstmp2(ji,jj,jk+1) |
---|
| 123 | sinktemp(ji,jj,jk+1) = -zew*(trn(ji,jj,jk,jn) |
---|
[617] | 124 | $ -0.5*(1+zigma)*zakz(ji,jj,jk))*zstep |
---|
[186] | 125 | ENDDO |
---|
| 126 | ENDDO |
---|
| 127 | ENDDO |
---|
| 128 | ! |
---|
| 129 | ! Boundary conditions |
---|
| 130 | ! |
---|
| 131 | sinktemp(:,:,1)=0. |
---|
| 132 | sinktemp(:,:,jpk)=0. |
---|
[339] | 133 | C |
---|
| 134 | DO jk=1,jpkm1 |
---|
| 135 | DO jj = 1,jpj |
---|
| 136 | DO ji = 1, jpi |
---|
[186] | 137 | ! |
---|
[339] | 138 | trn(ji,jj,jk,jn) = trn(ji,jj,jk,jn) |
---|
| 139 | & + (sinktemp(ji,jj,jk)-sinktemp(ji,jj,jk+1)) |
---|
| 140 | & /fse3t(ji,jj,jk) |
---|
| 141 | ! |
---|
| 142 | ENDDO |
---|
| 143 | ENDDO |
---|
| 144 | ENDDO |
---|
| 145 | ! |
---|
| 146 | trb(:,:,:,jn)=trn(:,:,:,jn) |
---|
| 147 | ! |
---|
[186] | 148 | #endif |
---|
| 149 | C |
---|
| 150 | RETURN |
---|
| 151 | END |
---|