Changeset 763 for branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcini.lobster1.h90
- Timestamp:
- 2007-12-13T14:52:50+01:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/SMS/trcini.lobster1.h90
r719 r763 1 !!====================================================================== 2 !! *** trcini.lobster1.h90 *** 3 !! TOP : Initialisation of LOBSTER 1 biological model 4 !!====================================================================== 5 !! History : - ! 1999-09 (M. Levy) Original code 6 !! - ! 2000-12 (0. Aumont, E. Kestenare) add sediment 7 !! 1.0 ! 2004-03 (C. Ethe) Modularity 8 !! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90 1 9 !!---------------------------------------------------------------------- 2 !! *** trcini.lobster1.h90 *** 3 !!---------------------------------------------------------------------- 10 4 11 # include "domzgr_substitute.h90" 5 12 # include "passivetrc_substitute.h90" 13 !!---------------------------------------------------------------------- 14 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 15 !! $Id:$ 16 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 17 !!---------------------------------------------------------------------- 18 6 19 CONTAINS 7 20 8 21 SUBROUTINE trc_ini 9 !!--------------------------------------------------------------------- 22 !!---------------------------------------------------------------------- 10 23 !! *** 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 24 !! ** purpose : specific initialisation for lobster1 model 21 25 !!---------------------------------------------------------------------- 22 !! TOP 1.0 , LOCEAN-IPSL (2005) 23 !! $Header$ 24 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 26 INTEGER :: ji, jj, jk, jn 27 REAL(wp) :: zdm0(jpi,jpj,jpk), zrro(jpi,jpj), zfluo, zfluu 28 REAL(wp) :: ztest, zfluo, zfluu 29 REAL(wp), DIMENSION(jpi,jpj) :: zrro 30 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdm0 25 31 !!---------------------------------------------------------------------- 26 !! local declarations27 !! ==================28 INTEGER ji,jj,jk,jn29 REAL zdm0(jpi,jpj,jpk),zrro(jpi,jpj),zfluo,zfluu30 REAL ztest31 32 32 !! 1. initialization of fields for optical model 33 !! -------------------------------------------- 33 ! initialization of fields for optical model 34 ! -------------------------------------------- 35 xze (:,:) = 5.e0 36 xpar(:,:,:) = 0.e0 34 37 35 xze(:,:)=5.36 xpar(:,:,:)=0.38 ! initialization for passive tracer remineralisation-damping array 39 ! ----------------------------------------------------------------- 37 40 38 !! 2. initialization for passive tracer remineralisation-damping array 39 !! ------------------------------------------------------------------------- 40 41 DO jn=1,jptra 42 remdmp(:,jn)=tminr 41 DO jn = 1, jptra 42 remdmp(:,jn) = tminr 43 43 END DO 44 44 … … 49 49 ENDIF 50 50 51 ! ! 3.initialization of biological variables52 ! !------------------------------------------51 ! initialization of biological variables 52 ! ------------------------------------------ 53 53 54 ! !Calculate vertical distribution of newly formed biogenic poc55 ! !in the water column in the case of max. possible bottom depth56 ! !------------------------------------------------------------54 ! Calculate vertical distribution of newly formed biogenic poc 55 ! in the water column in the case of max. possible bottom depth 56 ! ------------------------------------------------------------ 57 57 58 zdm0 = 0. 59 zrro = 1. 58 zdm0 = 0.e0 59 zrro = 1.e0 60 60 DO jk = jpkb,jpkm1 61 61 DO jj =1, jpj 62 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 !!! 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.e0 66 zdm0(ji,jj,jk) = zfluo - zfluu 67 IF( jk <= jpkb-1 ) zdm0(ji,jj,jk) = 0.e0 68 zrro(ji,jj) = zrro(ji,jj) - zdm0(ji,jj,jk) 69 END DO 70 END DO 71 END DO 73 72 74 73 zdm0(:,:,jpk) = zrro(:,:) 75 74 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 75 ! Calculate vertical distribution of newly formed biogenic poc 76 ! in the water column with realistic topography (first "dry" layer 77 ! contains total fraction, which has passed to the upper layers) 78 ! ---------------------------------------------------------------------- 81 79 dminl = 0. 82 80 dmin3 = zdm0 81 DO jk = 1, jpk 82 DO jj = 1, jpj 83 DO ji = 1, jpi 84 IF( tmask(ji,jj,jk) == 0. ) THEN 85 dminl(ji,jj) = dminl(ji,jj) + dmin3(ji,jj,jk) 86 dmin3(ji,jj,jk) = 0.e0 87 ENDIF 88 END DO 89 END DO 90 END DO 83 91 84 DO jk = 1,jpk 85 DO jj = 1,jpj 86 DO ji = 1,jpi 92 DO jj = 1, jpj 93 DO ji = 1, jpi 94 IF( tmask(ji,jj,1) == 0 ) dmin3(ji,jj,1) = 0.e0 95 END DO 96 END DO 87 97 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 98 ! Coastal mask 99 ! ------------ 100 cmask = 0.e0 101 DO ji = 2, jpi-1 102 DO jj = 2, jpj-1 108 103 if (tmask(ji,jj,1) == 1) then 109 104 ztest=tmask(ji+1,jj,1)*tmask(ji-1,jj,1)*tmask(ji,jj+1,1)*tmask(ji,jj-1,1) 110 105 IF (ztest == 0) cmask(ji,jj) = 1. 111 106 endif 112 end do113 end do107 END DO 108 END DO 114 109 115 cmask( 1,:)=cmask(jpi-1,:)116 cmask(jpi,:) =cmask(2,:)110 cmask( 1 ,:) = cmask(jpi-1,:) 111 cmask(jpi,:) = cmask( 2 ,:) 117 112 113 !!gm BUG !!!!! not valid in mpp and also not valid for north fold !!!!! 118 114 119 ! ! CALCUL DE LA SURFACE COTIERE120 ! ! ----------------------------121 areacot =0.122 do ji=2,jpi-1123 do jj=2,jpj-1124 areacot =areacot+e1t(ji,jj)*e2t(ji,jj)*cmask(ji,jj)125 end do126 end do127 115 ! Coastal surface 116 ! --------------- 117 areacot = 0.e0 118 DO ji = 2, jpi-1 119 DO jj = 2, jpj-1 120 areacot = areacot + e1t(ji,jj) * e2t(ji,jj) * cmask(ji,jj) 121 END DO 122 END DO 123 ! 128 124 END SUBROUTINE trc_ini
Note: See TracChangeset
for help on using the changeset viewer.