Changeset 494 for trunk/NEMO/TOP_SRC/SMS/trcini.pisces.h90
- Timestamp:
- 2006-09-01T16:03:49+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/TOP_SRC/SMS/trcini.pisces.h90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/SMS/trcini.pisces.h90
r341 r494 37 37 !!---------------------------------------------------------------------- 38 38 !! TOP 1.0 , LOCEAN-IPSL (2005) 39 !! $Header$ 40 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 41 !!---------------------------------------------------------------------- 39 !! $Header$ 40 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 41 !!---------------------------------------------------------------------- 42 !!Module used 43 USE iom 44 42 45 !! local declarations 43 46 !! ================== 44 47 INTEGER :: ji,jj,jk 45 INTEGER :: ichl,iband,mo 46 INTEGER , PARAMETER :: jpmois = 12, & 47 jpan = 1 48 49 REAL(wp) :: xtoto,expide,denitide,ztra,zmaskt 48 INTEGER :: ichl,iband,jm 49 INTEGER , PARAMETER :: jpmois = 12, jpan = 1 50 51 REAL(wp) :: ztoto,expide,denitide,ztra,zmaskt 50 52 REAL(wp) , DIMENSION (jpi,jpj) :: riverdoc,river,ndepo 51 CHARACTER (len=34) :: clname 52 53 INTEGER :: ipi,ipj,ipk,itime 54 INTEGER , DIMENSION (jpmois) :: istep 55 INTEGER , DIMENSION (jpan) :: istep0 56 REAL(wp) :: zsecond, zdate0 57 REAL(wp) , DIMENSION (jpi,jpj) :: zlon,zlat 58 REAL(wp), DIMENSION (jpk) :: zlev 53 59 54 INTEGER :: numriv,numdust,numbath,numdep 55 INTEGER :: numlight = 49 56 60 57 61 58 !! 1. initialization … … 72 69 IF(lwp) write(numout,*) ' Biology time step=',rfact2 73 70 71 74 72 !! INITIALISE DUST INPUT FROM ATMOSPHERE 75 73 !! ------------------------------------- 76 74 77 IF (bdustfer) THEN 78 clname='dust.orca.nc' 79 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0 & 80 & ,zlon,zlat,zlev,itime,istep,zdate0,zsecond,numdust) 81 CALL flinget(numdust,'dust',jpidta,jpjdta,0,jpmois,1, & 82 & 12,mig(1),nlci,mjg(1),nlcj,dustmo(1:nlci,1:nlcj,:) ) 83 CALL flinclo(numdust) 84 85 ! Extra-halo initialization in MPP 86 IF( lk_mpp ) THEN 87 DO ji = nlci+1, jpi 88 dustmo(ji,:,:) = dustmo(1,:,:) 89 ENDDO 90 DO jj = nlcj+1, jpj 91 dustmo(:,jj,:)=dustmo(:,1,:) 92 ENDDO 93 ENDIF 75 IF ( bdustfer ) THEN 76 IF(lwp) WRITE(numout,*) ' Initialize dust input from atmosphere ' 77 CALL iom_open ( 'dust.orca.nc', numdust ) 78 DO jm = 1, jpmois 79 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 80 ENDDO 81 CALL iom_close( numdust ) 94 82 ELSE 95 dustmo(:,:,:) =0.83 dustmo(:,:,:) = 0. 96 84 ENDIF 85 86 do jm = 1, jpmois 87 write(numout,*) ' Mois : ',jm 88 write(numout,*) ( ( dustmo(ji,jj,jm), ji=1,jpi,20),jj=1,jpj,20) 89 enddo 90 97 91 98 92 !! INITIALISE THE NUTRIENT INPUT BY RIVERS 99 93 !! --------------------------------------- 100 94 101 IF (briver) THEN 102 clname='river.orca.nc' 103 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0 & 104 & ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numriv) 105 CALL flinget(numriv,'riverdic',jpidta,jpjdta,0,jpan,1, & 106 & 1,mig(1),nlci,mjg(1),nlcj,river(1:nlci,1:nlcj) ) 107 CALL flinget(numriv,'riverdoc',jpidta,jpjdta,0,jpan,1, & 108 & 1,mig(1),nlci,mjg(1),nlcj,riverdoc(1:nlci,1:nlcj) ) 109 CALL flinclo(numriv) 110 111 ! Extra-halo initialization in MPP 112 IF( lk_mpp ) THEN 113 DO ji = nlci+1, jpi 114 river(ji,:) = river(1,:) 115 riverdoc(ji,:) = riverdoc(1,:) 116 ENDDO 117 DO jj = nlcj+1, jpj 118 river(:,jj)=river(:,1) 119 riverdoc(:,jj) = riverdoc(:,1) 120 ENDDO 121 ENDIF 122 95 IF ( briver ) THEN 96 IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by rivers ' 97 CALL iom_open ( 'river.orca.nc', numriv ) 98 CALL iom_get ( numriv, jpdom_data, 'riverdic', river (:,:), jpan ) 99 CALL iom_get ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan ) 100 CALL iom_close( numriv ) 123 101 ELSE 124 river (:,:)=0.125 riverdoc(:,:) =0.102 river (:,:) = 0. 103 riverdoc(:,:) = 0. 126 104 endif 127 105 … … 129 107 !! --------------------------------------- 130 108 131 IF (bndepo) THEN 132 clname='ndeposition.orca.nc' 133 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,0 & 134 & ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numdep) 135 CALL flinget(numdep,'ndep',jpidta,jpjdta,0,jpan,1, & 136 & 1,mig(1),nlci,mjg(1),nlcj,ndepo(1:nlci,1:nlcj) ) 137 CALL flinclo(numdep) 138 139 ! Extra-halo initialization in MPP 140 IF( lk_mpp ) THEN 141 DO ji = nlci+1, jpi 142 ndepo(ji,:) = ndepo(1,:) 143 ENDDO 144 DO jj = nlcj+1, jpj 145 ndepo(:,jj)=ndepo(:,1) 146 ENDDO 147 ENDIF 148 109 IF ( bndepo ) THEN 110 IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by dust ' 111 CALL iom_open ( 'ndeposition.orca.nc', numdep ) 112 CALL iom_get ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan ) 113 CALL iom_close( numdep ) 149 114 ELSE 150 ndepo(:,:) =0.115 ndepo(:,:) = 0. 151 116 ENDIF 152 117 153 118 !! Computation of the coastal mask. 154 !! Computation of an island mask to enhance coastal supply 155 !! of iron 156 !! ------------------------------------------------------- 157 158 IF (bsedinput) THEN 159 clname='bathy.orca.nc' 160 CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.false.,ipi,ipj,ipk & 161 & ,zlon,zlat,zlev,itime,istep0,zdate0,zsecond,numbath) 162 CALL flinget(numbath,'bathy',jpidta,jpjdta,jpk,jpan,1, & 163 & 1,mig(1),nlci,mjg(1),nlcj,cmask(1:nlci,1:nlcj,1:jpk) ) 164 CALL flinclo(numbath) 165 166 do jk=1,5 167 do jj=2,jpj-1 168 do ji=2,jpi-1 169 if (tmask(ji,jj,jk).ne.0) then 170 zmaskt=tmask(ji+1,jj,jk)*tmask(ji-1,jj,jk)*tmask(ji,jj+1,jk) & 171 & *tmask(ji,jj-1,jk)*tmask(ji,jj,jk+1) 172 if (zmaskt.eq.0) then 173 cmask(ji,jj,jk)=0.1 174 endif 175 endif 176 end do 177 end do 178 end do 179 180 181 ! Extra-halo initialization in MPP 182 IF( lk_mpp ) THEN 183 DO ji = nlci+1, jpi 184 cmask(ji,:,:) = cmask(1,:,:) 185 ENDDO 186 DO jj = nlcj+1, jpj 187 cmask(:,jj,:)=cmask(:,1,:) 188 ENDDO 189 ENDIF 190 119 !! Computation of an island mask to enhance coastal supply of iron 120 !! --------------------------------------------------------------- 121 122 IF ( bsedinput ) THEN 123 IF(lwp) WRITE(numout,*) ' Computation of an island mask to enhance coastal supply of iron ' 124 CALL iom_open ( 'bathy.orca.nc', numbath ) 125 CALL iom_get ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan ) 126 127 DO jk = 1, 5 128 DO jj = 2, jpjm1 129 DO ji = 2, jpim1 130 IF ( tmask(ji,jj,jk) /= 0. ) THEN 131 zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk) & 132 & * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 133 IF ( zmaskt == 0. ) THEN 134 cmask(ji,jj,jk ) = 0.1 135 ENDIF 136 ENDIF 137 END DO 138 END DO 139 END DO 191 140 DO jk = 1, jpk 192 141 DO jj = 1, jpj 193 142 DO ji = 1, jpi 194 expide =min(8.,(fsdept(ji,jj,jk)/500.)**(-1.5))195 denitide =-0.9543+0.7662*log(expide)-0.235*log(expide)**2196 cmask(ji,jj,jk) =cmask(ji,jj,jk)*min(1.,exp(denitide)/0.5)143 expide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 144 denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2 145 cmask(ji,jj,jk) = cmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 ) 197 146 END DO 198 147 END DO 199 148 END DO 200 149 150 CALL iom_close( numbath ) 201 151 ELSE 202 cmask(:,:,:) =0.152 cmask(:,:,:) = 0. 203 153 ENDIF 204 154 … … 209 159 !! ------------------------------------------------- 210 160 211 sumdepsi =0.212 DO mo=1,12213 DO jj =2,jpjm1214 DO ji =2,jpim1215 sumdepsi =sumdepsi+dustmo(ji,jj,mo)/(12.*rmoss)*8.8 &161 sumdepsi = 0. 162 DO jm = 1, jpmois 163 DO jj = 2, jpjm1 164 DO ji = 2, jpim1 165 sumdepsi = sumdepsi + dustmo(ji,jj,jm)/(12.*rmoss)*8.8 & 216 166 *0.075/28.1*e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,1) 217 167 END DO … … 472 422 !! A PRECOMPUTED ARRAY CORRESPONDING TO THE ATTENUATION COEFFICIENT 473 423 474 open(49,file='kRGB61.txt',form='formatted') 475 do ichl=1,61 476 READ(49,*) xtoto,(xkrgb(iband,ichl),iband = 1,3) 477 end do 478 close(49) 479 480 #if defined key_off_degrad 481 482 !! Read volume for degraded regions (DEGINIT) 483 !! ------------------------------------------ 484 485 # if defined key_vpp 486 CALL READ3S(902,facvol,jpi,jpj,jpk) 487 # else 488 READ (902) facvol 489 # endif 490 #endif 424 OPEN( numlight, file = 'kRGB61.txt', form = 'formatted') 425 DO ichl = 1,61 426 READ(numlight,*) ztoto,(xkrgb(iband,ichl),iband = 1,3) 427 END DO 428 CLOSE(numlight) 491 429 492 430
Note: See TracChangeset
for help on using the changeset viewer.
