Changeset 335 for trunk/NEMO/TOP_SRC/trcdta.F90
- Timestamp:
- 2005-11-14T13:08:42+01:00 (19 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/TOP_SRC/trcdta.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/trcdta.F90
r274 r335 5 5 !!===================================================================== 6 6 !! TOP 1.0, LOCEAN-IPSL (2005) 7 !! $Header$8 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt9 7 !!---------------------------------------------------------------------- 10 8 … … 16 14 !!---------------------------------------------------------------------- 17 15 !! * Modules used 18 19 20 21 16 USE oce_trc 17 USE trc 18 USE par_sms 19 USE lib_print 22 20 23 21 IMPLICIT NONE … … 51 49 !! Default case NetCDF file 52 50 !!---------------------------------------------------------------------- 53 51 54 52 SUBROUTINE dta_trc( kt ) 55 !!----------------------------------------------------------------------56 !! *** ROUTINE dta_trc ***57 !!58 !! ** Purpose : Reads passive tracer data (Levitus monthly data)59 !!60 !! ** Method : Read on unit numtr the interpolated tracer concentra-61 !! tion onto the global grid. Data begin at january.62 !! The value is centered at the middle of month.63 !! In the opa model, kt=1 agree with january 1.64 !! At each time step, a linear interpolation is applied between65 !! two monthly values.66 !!67 !! History :68 !! 8.2 ! 02-04 (O. Aumont) Original code69 !! 9.0 ! 04-03 (C. Ethe)70 !! 9.0 ! 05-03 (O. Aumont and A. El Moussaoui) F9071 !!----------------------------------------------------------------------72 !! * Modules used53 !!---------------------------------------------------------------------- 54 !! *** ROUTINE dta_trc *** 55 !! 56 !! ** Purpose : Reads passive tracer data (Levitus monthly data) 57 !! 58 !! ** Method : Read on unit numtr the interpolated tracer concentra- 59 !! tion onto the global grid. Data begin at january. 60 !! The value is centered at the middle of month. 61 !! In the opa model, kt=1 agree with january 1. 62 !! At each time step, a linear interpolation is applied between 63 !! two monthly values. 64 !! 65 !! History : 66 !! 8.2 ! 02-04 (O. Aumont) Original code 67 !! 9.0 ! 04-03 (C. Ethe) 68 !! 9.0 ! 05-03 (O. Aumont and A. El Moussaoui) F90 69 !!---------------------------------------------------------------------- 70 !! * Modules used 73 71 USE ioipsl 74 72 75 !! * Arguments73 !! * Arguments 76 74 !! * Arguments 77 75 INTEGER, INTENT( in ) :: kt ! ocean time-step 78 76 79 !! * Local declarations77 !! * Local declarations 80 78 INTEGER :: ji, jj, jn, jl 81 79 INTEGER, PARAMETER :: & … … 90 88 REAL(wp), DIMENSION (jpk) :: zlev 91 89 REAL(wp) :: zdate0, zxy, zl 92 !!----------------------------------------------------------------------90 !!---------------------------------------------------------------------- 93 91 94 92 DO jn = 1, jptra 95 93 96 IF( lutini(jn) ) THEN 97 98 IF ( kt == nit000 ) THEN 99 !! 3D tracer data 100 IF(lwp)WRITE(numout,*) 101 IF(lwp)WRITE(numout,*) ' trcdta: reading tracer' 102 IF(lwp)WRITE(numout,*) ' data file ', jn 103 IF(lwp)WRITE(numout,*) 104 nlectr(jn) = 0 105 ENDIF 106 ! Initialization 107 iman = jpmois 108 i15 = nday/16 109 imois = nmonth + i15 -1 110 IF( imois == 0 ) imois = iman 111 itime = jpmois 112 ipi = jpiglo 113 ipj = jpjglo 114 115 ! First call kt=nit000 116 ! -------------------- 117 118 IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN 119 ntrc1(jn) = 0 120 IF(lwp) THEN 121 WRITE(numout,*) 122 WRITE(numout,*) ' Tracer monthly fields' 123 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~' 124 WRITE(numout,*) ' NetCDF FORMAT' 125 WRITE(numout,*) 126 ENDIF 127 128 ! open file 129 130 clname(jn) = 'LEVITUS_'//ctrcnm(jn) 131 CALL flinopen(TRIM(clname(jn)),mig(1),nlci,mjg(1),nlcj, & 132 .FALSE.,ipi,ipj,ipk,zlon,zlat,zlev,itime, & 133 istep,zdate0,rdt,numtr(jn) ) 134 135 ! title, dimensions and tests 136 IF( itime /= jpmois ) THEN 94 IF( lutini(jn) ) THEN 95 96 IF ( kt == nit000 ) THEN 97 !! 3D tracer data 98 IF(lwp)WRITE(numout,*) 99 IF(lwp)WRITE(numout,*) ' trcdta: reading tracer' 100 IF(lwp)WRITE(numout,*) ' data file ', jn 101 IF(lwp)WRITE(numout,*) 102 nlectr(jn) = 0 103 ENDIF 104 ! Initialization 105 iman = jpmois 106 i15 = nday/16 107 imois = nmonth + i15 -1 108 IF( imois == 0 ) imois = iman 109 itime = jpmois 110 ipi = jpiglo 111 ipj = jpjglo 112 113 ! First call kt=nit000 114 ! -------------------- 115 116 IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN 117 ntrc1(jn) = 0 118 IF(lwp) THEN 119 WRITE(numout,*) 120 WRITE(numout,*) ' Tracer monthly fields' 121 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~' 122 WRITE(numout,*) ' NetCDF FORMAT' 123 WRITE(numout,*) 124 ENDIF 125 126 ! open file 127 128 clname(jn) = 'LEVITUS_'//ctrcnm(jn) 129 CALL flinopen(TRIM(clname(jn)),mig(1),nlci,mjg(1),nlcj, & 130 .FALSE.,ipi,ipj,ipk,zlon,zlat,zlev,itime, & 131 istep,zdate0,rdt,numtr(jn) ) 132 133 ! title, dimensions and tests 134 IF( itime /= jpmois ) THEN 135 IF(lwp) THEN 136 WRITE(numout,*) ' ' 137 WRITE(numout,*) 'problem with time coordinates' 138 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 139 ENDIF 140 STOP 'trc_dta' 141 ENDIF 142 143 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 144 IF(lwp) THEN 145 WRITE(numout,*) ' ' 146 WRITE(numout,*) 'problem with dimensions' 147 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 148 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 149 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 150 ENDIF 151 STOP 'trc_dta' 152 ENDIF 153 IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numtr(jn) 154 trdta(:,:,:,jn) = 0. 155 156 ENDIF 157 158 159 ! Read montly file 160 IF( ( kt == nit000 .AND. nlectr(jn) == 0) & 161 .OR. imois /= ntrc1(jn) ) THEN 162 nlectr(jn) = 1 163 164 ! Calendar computation 165 166 ! ntrc1 number of the first file record used in the simulation 167 ! ntrc2 number of the last file record 168 169 ntrc1(jn) = imois 170 ntrc2(jn) = ntrc1(jn) + 1 171 ntrc1(jn) = MOD( ntrc1(jn), iman ) 172 IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman 173 ntrc2(jn) = MOD( ntrc2(jn), iman ) 174 IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman 175 IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn) 176 IF(lwp) WRITE(numout,*) 'last record file used ntrc2 ', ntrc2(jn) 177 178 ! Read montly passive tracer data Levitus 179 180 CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk, & 181 jpmois,ntrc1(jn),ntrc1(jn),mig(1),nlci,mjg(1),nlcj, & 182 tracdta(1:nlci,1:nlcj,1:jpk,jn,1) ) 183 184 CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk, & 185 jpmois,ntrc2(jn),ntrc2(jn),mig(1),nlci,mjg(1),nlcj, & 186 tracdta(1:nlci,1:nlcj,1:jpk,jn,2) ) 187 188 IF(lwp) THEN 189 WRITE(numout,*) 190 WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok' 191 WRITE(numout,*) 192 ENDIF 193 194 ! Apply Mask 195 DO jl = 1, 2 196 tracdta(:,:,: ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:) 197 tracdta(:,:,jpk,jn,jl) = 0. 198 IF( lk_zps ) THEN ! z-coord. with partial steps 199 DO jj = 1, jpj ! interpolation of temperature at the last level 200 DO ji = 1, jpi 201 ik = mbathy(ji,jj) - 1 202 IF( ik > 2 ) THEN 203 zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 204 tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik,jn,jl) + zl * tracdta(ji,jj,ik-1,jn,jl) 205 ENDIF 206 END DO 207 END DO 208 ENDIF 209 210 END DO 211 212 ENDIF 213 137 214 IF(lwp) THEN 138 WRITE(numout,*) ' ' 139 WRITE(numout,*) 'problem with time coordinates' 140 WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 141 ENDIF 142 STOP 'trc_dta' 143 ENDIF 144 145 IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 146 IF(lwp) THEN 147 WRITE(numout,*) ' ' 148 WRITE(numout,*) 'problem with dimensions' 149 WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 150 WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 151 WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 152 ENDIF 153 STOP 'trc_dta' 154 ENDIF 155 IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numtr(jn) 156 trdta(:,:,:,jn) = 0. 157 158 ENDIF 159 160 161 ! Read montly file 162 IF( ( kt == nit000 .AND. nlectr(jn) == 0) & 163 .OR. imois /= ntrc1(jn) ) THEN 164 nlectr(jn) = 1 165 166 ! Calendar computation 167 168 ! ntrc1 number of the first file record used in the simulation 169 ! ntrc2 number of the last file record 170 171 ntrc1(jn) = imois 172 ntrc2(jn) = ntrc1(jn) + 1 173 ntrc1(jn) = MOD( ntrc1(jn), iman ) 174 IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman 175 ntrc2(jn) = MOD( ntrc2(jn), iman ) 176 IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman 177 IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn) 178 IF(lwp) WRITE(numout,*) 'last record file used ntrc2 ', ntrc2(jn) 179 180 ! Read montly passive tracer data Levitus 181 182 CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk, & 183 jpmois,ntrc1(jn),ntrc1(jn),mig(1),nlci,mjg(1),nlcj, & 184 tracdta(1:nlci,1:nlcj,1:jpk,jn,1) ) 185 186 CALL flinget( numtr(jn),ctrcnm(jn),jpidta,jpjdta,jpk, & 187 jpmois,ntrc2(jn),ntrc2(jn),mig(1),nlci,mjg(1),nlcj, & 188 tracdta(1:nlci,1:nlcj,1:jpk,jn,2) ) 189 190 IF(lwp) THEN 191 WRITE(numout,*) 192 WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok' 193 WRITE(numout,*) 194 ENDIF 195 196 ! Apply Mask 197 DO jl = 1, 2 198 tracdta(:,:,: ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:) 199 tracdta(:,:,jpk,jn,jl) = 0. 200 IF( lk_zps ) THEN ! z-coord. with partial steps 201 DO jj = 1, jpj ! interpolation of temperature at the last level 202 DO ji = 1, jpi 203 ik = mbathy(ji,jj) - 1 204 IF( ik > 2 ) THEN 205 zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 206 tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik,jn,jl) + zl * tracdta(ji,jj,ik-1,jn,jl) 207 ENDIF 208 END DO 209 END DO 210 ENDIF 211 212 END DO 213 214 ENDIF 215 216 IF(lwp) THEN 217 WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), & 218 ntrc2(jn) 219 WRITE(numout,*) 220 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), & 215 WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), & 216 ntrc2(jn) 217 WRITE(numout,*) 218 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), & 221 219 ' level = 1' 222 CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1 &220 CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1 & 223 221 ,jpj, 20, 1., numout ) 224 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), &222 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), & 225 223 ' level = ',jpk/2 226 CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi, &224 CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi, & 227 225 20, 1, jpj, 20, 1., numout ) 228 WRITE(numout,*) ' Levitus month = ',ntrc1(jn) &226 WRITE(numout,*) ' Levitus month = ',ntrc1(jn) & 229 227 ,' level = ',jpkm1 230 CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi, &228 CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi, & 231 229 20, 1, jpj, 20, 1., numout ) 232 ENDIF233 234 ! At every time step compute temperature data235 236 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30.237 trdta(:,:,:,jn)= ( 1. - zxy ) * tracdta(:,:,:,jn,1) &238 239 240 IF( jn == jpno3) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6E-6241 IF( jn == jpdic) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6242 IF( jn == jptal) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6243 IF( jn == jpoxy) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6E-6244 IF( jn == jpsil) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6245 246 247 ENDIF230 ENDIF 231 232 ! At every time step compute temperature data 233 234 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 235 trdta(:,:,:,jn)= ( 1. - zxy ) * tracdta(:,:,:,jn,1) & 236 + zxy * tracdta(:,:,:,jn,2) 237 238 IF( jn == jpno3) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6E-6 239 IF( jn == jpdic) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6 240 IF( jn == jptal) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6 241 IF( jn == jpoxy) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6E-6 242 IF( jn == jpsil) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6 243 244 245 ENDIF 248 246 249 247 END DO
Note: See TracChangeset
for help on using the changeset viewer.
