| 1 | !!---------------------------------------------------------------------- |
|---|
| 2 | !! *** trcini.lobster1.h90 *** |
|---|
| 3 | !!---------------------------------------------------------------------- |
|---|
| 4 | # include "domzgr_substitute.h90" |
|---|
| 5 | # include "passivetrc_substitute.h90" |
|---|
| 6 | CONTAINS |
|---|
| 7 | |
|---|
| 8 | SUBROUTINE trc_ini |
|---|
| 9 | !!--------------------------------------------------------------------- |
|---|
| 10 | !! *** ROUTINE trc_ini *** |
|---|
| 11 | !! purpose : |
|---|
| 12 | !! --------- |
|---|
| 13 | !! specific initialisation for lobster1 model |
|---|
| 14 | !! |
|---|
| 15 | !! History : |
|---|
| 16 | !! -------- |
|---|
| 17 | !! original : 99-09 (M. Levy) |
|---|
| 18 | !! additions : 00-12 (0. Aumont, E. Kestenare) |
|---|
| 19 | !! add sediment computations |
|---|
| 20 | !! 03-05 : O. Aumont and A. El Moussaoui F90 |
|---|
| 21 | !!---------------------------------------------------------------------- |
|---|
| 22 | !! TOP 1.0 , LOCEAN-IPSL (2005) |
|---|
| 23 | !! $Header$ |
|---|
| 24 | !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt |
|---|
| 25 | !!---------------------------------------------------------------------- |
|---|
| 26 | !! local declarations |
|---|
| 27 | !! ================== |
|---|
| 28 | INTEGER ji,jj,jk,jn |
|---|
| 29 | REAL zdm0(jpi,jpj,jpk),zrro(jpi,jpj),zfluo,zfluu |
|---|
| 30 | REAL ztest |
|---|
| 31 | |
|---|
| 32 | !! 1. initialization of fields for optical model |
|---|
| 33 | !! -------------------------------------------- |
|---|
| 34 | |
|---|
| 35 | xze(:,:)=5. |
|---|
| 36 | xpar(:,:,:)=0. |
|---|
| 37 | |
|---|
| 38 | !! 2. initialization for passive tracer remineralisation-damping array |
|---|
| 39 | !! ------------------------------------------------------------------------- |
|---|
| 40 | |
|---|
| 41 | DO jn=1,jptra |
|---|
| 42 | remdmp(:,jn)=tminr |
|---|
| 43 | END DO |
|---|
| 44 | |
|---|
| 45 | IF(lwp) THEN |
|---|
| 46 | WRITE(numout,*) ' ' |
|---|
| 47 | WRITE(numout,*) ' trcini: compute remineralisation-damping ' |
|---|
| 48 | WRITE(numout,*) ' arrays for tracers' |
|---|
| 49 | ENDIF |
|---|
| 50 | |
|---|
| 51 | !! 3. initialization of biological variables |
|---|
| 52 | !! ------------------------------------------ |
|---|
| 53 | |
|---|
| 54 | !! Calculate vertical distribution of newly formed biogenic poc |
|---|
| 55 | !! in the water column in the case of max. possible bottom depth |
|---|
| 56 | !! ------------------------------------------------------------ |
|---|
| 57 | |
|---|
| 58 | zdm0 = 0. |
|---|
| 59 | zrro = 1. |
|---|
| 60 | DO jk = jpkb,jpkm1 |
|---|
| 61 | DO jj =1, jpj |
|---|
| 62 | DO ji =1, jpi |
|---|
| 63 | zfluo = (fsdepw(ji,jj,jk)/fsdepw(ji,jj,jpkb))**xhr |
|---|
| 64 | zfluu = (fsdepw(ji,jj,jk+1)/fsdepw(ji,jj,jpkb))**xhr |
|---|
| 65 | IF (zfluo.GT.1.) zfluo = 1. |
|---|
| 66 | zdm0(ji,jj,jk) = zfluo-zfluu |
|---|
| 67 | IF (jk.LE.jpkb-1) zdm0(ji,jj,jk)=0. |
|---|
| 68 | zrro(ji,jj) = zrro(ji,jj)-zdm0(ji,jj,jk) |
|---|
| 69 | ENDDO |
|---|
| 70 | ENDDO |
|---|
| 71 | ENDDO |
|---|
| 72 | !!! |
|---|
| 73 | |
|---|
| 74 | zdm0(:,:,jpk) = zrro(:,:) |
|---|
| 75 | |
|---|
| 76 | !! Calculate vertical distribution of newly formed biogenic poc |
|---|
| 77 | !! in the water column with realistic topography (first "dry" layer |
|---|
| 78 | !! contains total fraction, which has passed to the upper layers) |
|---|
| 79 | !! ---------------------------------------------------------------------- |
|---|
| 80 | |
|---|
| 81 | dminl = 0. |
|---|
| 82 | dmin3 = zdm0 |
|---|
| 83 | |
|---|
| 84 | DO jk = 1,jpk |
|---|
| 85 | DO jj = 1,jpj |
|---|
| 86 | DO ji = 1,jpi |
|---|
| 87 | |
|---|
| 88 | IF(tmask(ji,jj,jk) == 0) THEN |
|---|
| 89 | dminl(ji,jj) = dminl(ji,jj)+dmin3(ji,jj,jk) |
|---|
| 90 | dmin3(ji,jj,jk) = 0.0 |
|---|
| 91 | ENDIF |
|---|
| 92 | |
|---|
| 93 | ENDDO |
|---|
| 94 | ENDDO |
|---|
| 95 | ENDDO |
|---|
| 96 | |
|---|
| 97 | DO jj = 1,jpj |
|---|
| 98 | DO ji = 1,jpi |
|---|
| 99 | IF (tmask(ji,jj,1) == 0) dmin3(ji,jj,1) = 0. |
|---|
| 100 | ENDDO |
|---|
| 101 | ENDDO |
|---|
| 102 | |
|---|
| 103 | !! CALCUL DU MASK DE COTE |
|---|
| 104 | !! ---------------------- |
|---|
| 105 | cmask=0. |
|---|
| 106 | do ji=2,jpi-1 |
|---|
| 107 | do jj=2,jpj-1 |
|---|
| 108 | if (tmask(ji,jj,1) == 1) then |
|---|
| 109 | ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) |
|---|
| 110 | IF (ztest == 0) cmask(ji,jj) = 1. |
|---|
| 111 | endif |
|---|
| 112 | end do |
|---|
| 113 | end do |
|---|
| 114 | |
|---|
| 115 | cmask(1,:)=cmask(jpi-1,:) |
|---|
| 116 | cmask(jpi,:)=cmask(2,:) |
|---|
| 117 | |
|---|
| 118 | |
|---|
| 119 | !! CALCUL DE LA SURFACE COTIERE |
|---|
| 120 | !! ---------------------------- |
|---|
| 121 | areacot=0. |
|---|
| 122 | do ji=2,jpi-1 |
|---|
| 123 | do jj=2,jpj-1 |
|---|
| 124 | areacot=areacot+e1t(ji,jj)*e2t(ji,jj)*cmask(ji,jj) |
|---|
| 125 | end do |
|---|
| 126 | end do |
|---|
| 127 | |
|---|
| 128 | END SUBROUTINE trc_ini |
|---|
