Changeset 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r2715 r3294 7 7 !! - ! 2004-03 (C. Ethe) module 8 8 !! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90 9 !!---------------------------------------------------------------------- 10 #if defined key_top && defined key_dtatrc 11 !!---------------------------------------------------------------------- 12 !! 'key_top' and 'key_dtatrc' TOP model + passive tracer data 13 !!---------------------------------------------------------------------- 14 !! trc_dta : read ocean passive tracer data 15 !!---------------------------------------------------------------------- 16 USE oce_trc 17 USE par_trc 18 USE trc 19 USE lib_print 20 USE iom 9 !! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation 10 !!---------------------------------------------------------------------- 11 #if defined key_top 12 !!---------------------------------------------------------------------- 13 !! 'key_top' TOP model 14 !!---------------------------------------------------------------------- 15 !! trc_dta : read and time interpolated passive tracer data 16 !!---------------------------------------------------------------------- 17 USE par_trc ! passive tracers parameters 18 USE oce_trc ! shared variables between ocean and passive tracers 19 USE trc ! passive tracers common variables 20 USE iom ! I/O manager 21 USE lib_mpp ! MPP library 22 USE fldread ! read input fields 21 23 22 24 IMPLICIT NONE … … 24 26 25 27 PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90 26 PUBLIC trc_dta_alloc ! called in nemogcm.F90 27 28 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .TRUE. !: temperature data flag 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: trdta !: tracer data at given time-step 30 31 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: tracdta ! tracer data at two consecutive times 32 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: nlectr !: switch for reading once 33 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: ntrc1 !: number of 1st month when reading 12 monthly value 34 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) :: ntrc2 !: number of 2nd month when reading 12 monthly value 28 PUBLIC trc_dta_init ! called in trcini.F90 29 30 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data 31 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data 32 INTEGER , SAVE :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 33 REAL(wp) , SAVE, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values 34 TYPE(FLD), SAVE, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 35 35 36 36 !! * Substitutions 37 # include " top_substitute.h90"38 !!---------------------------------------------------------------------- 39 !! NEMO/ TOP3.3 , NEMO Consortium (2010)37 # include "domzgr_substitute.h90" 38 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 40 40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 43 CONTAINS 44 44 45 SUBROUTINE trc_dta( kt ) 45 SUBROUTINE trc_dta_init 46 !!---------------------------------------------------------------------- 47 !! *** ROUTINE trc_dta_init *** 48 !! 49 !! ** Purpose : initialisation of passive tracer input data 50 !! 51 !! ** Method : - Read namtsd namelist 52 !! - allocates passive tracer data structure 53 !!---------------------------------------------------------------------- 54 ! 55 INTEGER :: jl, jn ! dummy loop indicies 56 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 57 CHARACTER(len=100) :: clndta, clntrc 58 REAL(wp) :: zfact 59 ! 60 CHARACTER(len=100) :: cn_dir 61 TYPE(FLD_N), DIMENSION(jptra) :: slf_i ! array of namelist informations on the fields to read 62 TYPE(FLD_N), DIMENSION(jptra) :: sn_trcdta 63 REAL(wp) , DIMENSION(jptra) :: rn_trfac ! multiplicative factor for tracer values 64 !! 65 NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac 66 !!---------------------------------------------------------------------- 67 ! 68 IF( nn_timing == 1 ) CALL timing_start('trc_dta_init') 69 ! 70 ! Initialisation 71 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 72 ! Compute the number of tracers to be initialised with data 73 ALLOCATE( n_trc_index(jptra), STAT=ierr0 ) 74 IF( ierr0 > 0 ) THEN 75 CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' ) ; RETURN 76 ENDIF 77 nb_trcdta = 0 78 n_trc_index(:) = 0 79 DO jn = 1, jptra 80 IF( ln_trc_ini(jn) ) THEN 81 nb_trcdta = nb_trcdta + 1 82 n_trc_index(jn) = nb_trcdta 83 ENDIF 84 ENDDO 85 ! 86 ntra = MAX( 1, nb_trcdta ) ! To avoid compilation error with bounds checking 87 WRITE(numout,*) ' ' 88 WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 89 WRITE(numout,*) ' ' 90 ! ! allocate the arrays (if necessary) 91 ! 92 cn_dir = './' ! directory in which the model is executed 93 DO jn = 1, jptra 94 WRITE( clndta,'("TR_",I1)' ) jn 95 clndta = TRIM( clndta ) 96 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 97 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 98 sn_trcdta(jn) = FLD_N( clndta , -1 , clndta , .false. , .true. , 'monthly' , '' , '' ) 99 ! 100 rn_trfac(jn) = 1._wp 101 END DO 102 ! 103 REWIND( numnat ) ! read nattrc 104 READ ( numnat, namtrc_dta ) 105 106 IF( lwp ) THEN 107 DO jn = 1, jptra 108 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 109 clndta = TRIM( sn_trcdta(jn)%clvar ) 110 clntrc = TRIM( ctrcnm (jn) ) 111 zfact = rn_trfac(jn) 112 IF( clndta /= clntrc ) THEN 113 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation : ', & 114 & 'the variable name in the data file : '//clndta// & 115 & ' must be the same than the name of the passive tracer : '//clntrc//' ') 116 ENDIF 117 WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 118 & ' multiplicative factor : ', zfact 119 ENDIF 120 END DO 121 ENDIF 122 ! 123 IF( nb_trcdta > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero 124 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 125 IF( ierr1 > 0 ) THEN 126 CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN 127 ENDIF 128 ! 129 DO jn = 1, jptra 130 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 131 jl = n_trc_index(jn) 132 slf_i(jl) = sn_trcdta(jn) 133 rf_trfac(jl) = rn_trfac(jn) 134 ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 ) 135 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 136 IF( ierr2 + ierr3 > 0 ) THEN 137 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN 138 ENDIF 139 ENDIF 140 ! 141 ENDDO 142 ! ! fill sf_trcdta with slf_i and control print 143 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 144 ! 145 ENDIF 146 ! 147 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_init') 148 ! 149 END SUBROUTINE trc_dta_init 150 151 152 SUBROUTINE trc_dta( kt, ptrc ) 46 153 !!---------------------------------------------------------------------- 47 154 !! *** ROUTINE trc_dta *** 155 !! 156 !! ** Purpose : provides passive tracer data at kt 157 !! 158 !! ** Method : - call fldread routine 159 !! - s- or mixed z-s coordinate: vertical interpolation on model mesh 160 !! - ln_trcdmp=F: deallocates the data structure as they are not used 48 161 !! 49 !! ** Purpose : Reads passive tracer data (Levitus monthly data) 50 !! 51 !! ** Method : Read on unit numtr the interpolated tracer concentra- 52 !! tion onto the global grid. Data begin at january. 53 !! The value is centered at the middle of month. 54 !! In the opa model, kt=1 agree with january 1. 55 !! At each time step, a linear interpolation is applied between 56 !! two monthly values. 57 !!---------------------------------------------------------------------- 58 INTEGER, INTENT(in) :: kt ! ocean time-step 59 !! 60 CHARACTER (len=39) :: clname(jptra) 61 INTEGER, PARAMETER :: jpmonth = 12 ! number of months 62 INTEGER :: ji, jj, jn, jl 63 INTEGER :: imois, iman, i15, ik ! temporary integers 64 REAL(wp) :: zxy, zl 65 !!gm HERE the daymod should be used instead of computation of month and co !! 66 !!gm better in case of real calandar and leap-years ! 67 !!---------------------------------------------------------------------- 68 69 DO jn = 1, jptra 70 71 IF( lutini(jn) ) THEN 72 73 IF ( kt == nit000 ) THEN 74 !! 3D tracer data 75 IF(lwp)WRITE(numout,*) 76 IF(lwp)WRITE(numout,*) ' dta_trc: reading tracer' 77 IF(lwp)WRITE(numout,*) ' data file ', jn, ctrcnm(jn) 78 IF(lwp)WRITE(numout,*) 79 nlectr(jn) = 0 162 !! ** Action : ptrc passive tracer data on medl mesh and interpolated at time-step kt 163 !!---------------------------------------------------------------------- 164 INTEGER , INTENT(in ) :: kt ! ocean time-step 165 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: ptrc ! passive tracer data 166 ! 167 INTEGER :: ji, jj, jk, jl, jn, jkk, ik ! dummy loop indicies 168 REAL(wp):: zl, zi 169 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 170 CHARACTER(len=100) :: clndta 171 !!---------------------------------------------------------------------- 172 ! 173 IF( nn_timing == 1 ) CALL timing_start('trc_dta') 174 ! 175 IF( nb_trcdta > 0 ) THEN 176 ! 177 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 178 ! 179 DO jn = 1, ntra 180 ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:) ! NO mask 181 ENDDO 182 ! 183 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 184 ! 185 IF( kt == nit000 .AND. lwp )THEN 186 WRITE(numout,*) 187 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 80 188 ENDIF 81 ! Initialization 82 iman = jpmonth 83 i15 = nday / 16 84 imois = nmonth + i15 -1 85 IF( imois == 0 ) imois = iman 86 87 88 ! First call kt=nit000 89 ! -------------------- 90 91 IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN 92 ntrc1(jn) = 0 93 IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' 94 ! open file 95 # if defined key_pisces 96 clname(jn) = 'data_1m_'//TRIM(ctrcnm(jn))//'_nomask' 97 # else 98 clname(jn) = TRIM(ctrcnm(jn)) 99 # endif 100 CALL iom_open ( clname(jn), numtr(jn) ) 101 102 ENDIF 103 104 # if defined key_pisces 105 ! Read montly file 106 IF( ( kt == nit000 .AND. nlectr(jn) == 0) .OR. imois /= ntrc1(jn) ) THEN 107 nlectr(jn) = 1 108 109 ! Calendar computation 110 111 ! ntrc1 number of the first file record used in the simulation 112 ! ntrc2 number of the last file record 113 114 ntrc1(jn) = imois 115 ntrc2(jn) = ntrc1(jn) + 1 116 ntrc1(jn) = MOD( ntrc1(jn), iman ) 117 IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman 118 ntrc2(jn) = MOD( ntrc2(jn), iman ) 119 IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman 120 IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn) 121 IF(lwp) WRITE(numout,*) 'last record file used ntrc2 ', ntrc2(jn) 122 123 ! Read montly passive tracer data Levitus 124 125 CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,1), ntrc1(jn) ) 126 CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,2), ntrc2(jn) ) 127 128 IF(lwp) THEN 129 WRITE(numout,*) 130 WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok' 131 WRITE(numout,*) 189 ! 190 DO jn = 1, ntra 191 DO jj = 1, jpj ! vertical interpolation of T & S 192 DO ji = 1, jpi 193 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 194 zl = fsdept_0(ji,jj,jk) 195 IF( zl < gdept_0(1 ) ) THEN ! above the first level of data 196 ztp(jk) = ptrc(ji,jj,1 ,jn) 197 ELSEIF( zl > gdept_0(jpk) ) THEN ! below the last level of data 198 ztp(jk) = ptrc(ji,jj,jpkm1,jn) 199 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 200 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 201 IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 202 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 203 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi 204 ENDIF 205 END DO 206 ENDIF 207 END DO 208 DO jk = 1, jpkm1 209 ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 210 END DO 211 ptrc(ji,jj,jpk,jn) = 0._wp 212 END DO 213 END DO 214 ENDDO 215 ! 216 ELSE !== z- or zps- coordinate ==! 217 ! 218 DO jn = 1, ntra 219 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:) ! Mask 220 ! 221 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 222 DO jj = 1, jpj 223 DO ji = 1, jpi 224 ik = mbkt(ji,jj) 225 IF( ik > 1 ) THEN 226 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 227 ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn) 228 ENDIF 229 END DO 230 END DO 132 231 ENDIF 133 134 ! Apply Mask 135 DO jl = 1, 2 136 tracdta(:,:,: ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:) 137 tracdta(:,:,jpk,jn,jl) = 0. 138 IF( ln_zps ) THEN ! z-coord. with partial steps 139 DO jj = 1, jpj ! interpolation of temperature at the last level 140 DO ji = 1, jpi 141 ik = mbkt(ji,jj) 142 IF( ik > 2 ) THEN 143 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 144 tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik ,jn,jl) & 145 & + zl * tracdta(ji,jj,ik-1,jn,jl) 146 ENDIF 147 END DO 148 END DO 149 ENDIF 150 151 END DO 152 153 ENDIF 154 155 IF(lwp) THEN 156 WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), ntrc2(jn) 232 ENDDO 233 ! 234 ENDIF 235 ! 236 DO jn = 1, ntra 237 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn) ! multiplicative factor 238 ENDDO 239 ! 240 IF( lwp .AND. kt == nit000 ) THEN 241 DO jn = 1, ntra 242 clndta = TRIM( sf_trcdta(jn)%clvar ) 243 WRITE(numout,*) ''//clndta//' data ' 157 244 WRITE(numout,*) 158 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), ' level = 1' 159 CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1 & 160 & ,jpj, 20, 1., numout ) 161 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), ' level = ',jpk/2 162 CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi, & 163 & 20, 1, jpj, 20, 1., numout ) 164 WRITE(numout,*) ' Levitus month = ',ntrc1(jn),' level = ',jpkm1 165 CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi, & 166 & 20, 1, jpj, 20, 1., numout ) 167 ENDIF 168 169 ! At every time step compute temperature data 170 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 171 trdta(:,:,:,jn) = ( 1. - zxy ) * tracdta(:,:,:,jn,1) & 172 & + zxy * tracdta(:,:,:,jn,2) 173 174 IF( jn == jpno3 ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6e-6 175 IF( jn == jpdic ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.0e-6 176 IF( jn == jptal ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.0e-6 177 IF( jn == jpoxy ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6e-6 178 IF( jn == jpsil ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.0e-6 179 IF( jn == jppo4 ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.0e-6 180 181 ! Close the file 182 ! -------------- 183 184 IF( kt == nitend ) CALL iom_close( numtr(jn) ) 185 186 # else 187 ! Read init file only 188 IF( kt == nit000 ) THEN 189 ntrc1(jn) = 1 190 CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 191 trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) 192 CALL iom_close ( numtr(jn) ) 193 ENDIF 194 # endif 195 ENDIF 196 197 END DO 245 WRITE(numout,*)' level = 1' 246 CALL prihre( ptrc(:,:,1 ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 247 WRITE(numout,*)' level = ', jpk/2 248 CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 249 WRITE(numout,*)' level = ', jpkm1 250 CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 251 WRITE(numout,*) 252 ENDDO 253 ENDIF 254 ! 255 IF( .NOT.ln_trcdmp ) THEN !== deallocate data structure ==! 256 ! (data used only for initialisation) 257 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 258 DO jn = 1, ntra 259 DEALLOCATE( sf_trcdta(jn)%fnow ) ! arrays in the structure 260 IF( sf_trcdta(jn)%ln_tint ) DEALLOCATE( sf_trcdta(jn)%fdta ) 261 ENDDO 262 DEALLOCATE( sf_trcdta ) ! the structure itself 263 ! 264 ENDIF 265 ! 266 ENDIF 267 ! 268 IF( nn_timing == 1 ) CALL timing_stop('trc_dta') 198 269 ! 199 270 END SUBROUTINE trc_dta 200 201 202 INTEGER FUNCTION trc_dta_alloc()203 !!----------------------------------------------------------------------204 !! *** ROUTINE trc_dta_alloc ***205 !!----------------------------------------------------------------------206 ALLOCATE( trdta (jpi,jpj,jpk,jptra ) , &207 & tracdta(jpi,jpj,jpk,jptra,2) , &208 & nlectr(jptra) , ntrc1(jptra) , ntrc2(jptra) , STAT=trc_dta_alloc)209 !210 IF( trc_dta_alloc /= 0 ) CALL ctl_warn('trc_dta_alloc : failed to allocate arrays')211 !212 END FUNCTION trc_dta_alloc213 214 271 #else 215 272 !!---------------------------------------------------------------------- 216 273 !! Dummy module NO 3D passive tracer data 217 274 !!---------------------------------------------------------------------- 218 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .FALSE. !: temperature data flag219 275 CONTAINS 220 276 SUBROUTINE trc_dta( kt ) ! Empty routine … … 222 278 END SUBROUTINE trc_dta 223 279 #endif 224 225 280 !!====================================================================== 226 281 END MODULE trcdta
Note: See TracChangeset
for help on using the changeset viewer.