- Timestamp:
- 2011-08-09T10:29:53+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r2715 r2819 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 ! Initialisation 69 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 70 ! Compute the number of tracers to be initialised with data 71 ALLOCATE( n_trc_index(jptra), STAT=ierr0 ) 72 IF( ierr0 > 0 ) THEN 73 CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' ) ; RETURN 74 ENDIF 75 nb_trcdta = 0 76 n_trc_index(:) = 0 77 DO jn = 1, jptra 78 IF( ln_trc_ini(jn) ) THEN 79 nb_trcdta = nb_trcdta + 1 80 n_trc_index(jn) = nb_trcdta 81 ENDIF 82 ENDDO 83 ! 84 ntra = MAX( 1, nb_trcdta ) ! To avoid compilation error with bounds checking 85 WRITE(numout,*) ' ' 86 WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 87 WRITE(numout,*) ' ' 88 ! ! allocate the arrays (if necessary) 89 ! 90 cn_dir = './' ! directory in which the model is executed 91 DO jn = 1, jptra 92 WRITE( clndta,'("TR_",I1)' ) jn 93 clndta = TRIM( clndta ) 94 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 95 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 96 sn_trcdta(jn) = FLD_N( clndta , -1 , clndta , .false. , .true. , 'monthly' , '' , '' ) 97 ! 98 rn_trfac(jn) = 1._wp 99 END DO 100 ! 101 REWIND( numnat ) ! read nattrc 102 READ ( numnat, namtrc_dta ) 103 104 IF( lwp ) THEN 105 DO jn = 1, jptra 106 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 107 clndta = TRIM( sn_trcdta(jn)%clvar ) 108 clntrc = TRIM( ctrcnm (jn) ) 109 zfact = rn_trfac(jn) 110 IF( clndta /= clntrc ) THEN 111 CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation : ', & 112 & 'the variable name in the data file : '//clndta// & 113 & ' must be the same than the name of the passive tracer : '//clntrc//' ') 114 ENDIF 115 WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, & 116 & ' multiplicative factor : ', zfact 117 ENDIF 118 END DO 119 ENDIF 120 ! 121 IF( nb_trcdta > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero 122 ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 123 IF( ierr1 > 0 ) THEN 124 CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN 125 ENDIF 126 ! 127 DO jn = 1, jptra 128 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 129 jl = n_trc_index(jn) 130 slf_i(jl) = sn_trcdta(jn) 131 rf_trfac(jl) = rn_trfac(jn) 132 ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 ) 133 IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 134 IF( ierr2 + ierr3 > 0 ) THEN 135 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' ) ; RETURN 136 ENDIF 137 ENDIF 138 ! 139 ENDDO 140 ! ! fill sf_trcdta with slf_i and control print 141 CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 142 ! 143 ENDIF 144 ! 145 END SUBROUTINE trc_dta_init 146 147 148 SUBROUTINE trc_dta( kt, ptrc ) 46 149 !!---------------------------------------------------------------------- 47 150 !! *** ROUTINE trc_dta *** 151 !! 152 !! ** Purpose : provides passive tracer data at kt 153 !! 154 !! ** Method : - call fldread routine 155 !! - s- or mixed z-s coordinate: vertical interpolation on model mesh 156 !! - ln_trcdmp=F: deallocates the data structure as they are not used 48 157 !! 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 158 !! ** Action : ptrc passive tracer data on medl mesh and interpolated at time-step kt 159 !!---------------------------------------------------------------------- 160 INTEGER , INTENT(in ) :: kt ! ocean time-step 161 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: ptrc ! passive tracer data 162 ! 163 INTEGER :: ji, jj, jk, jl, jn, jkk, ik ! dummy loop indicies 164 REAL(wp):: zl, zi 165 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace 166 CHARACTER(len=100) :: clndta 167 !!---------------------------------------------------------------------- 168 ! 169 IF( nb_trcdta > 0 ) THEN 170 ! 171 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 172 ! 173 DO jn = 1, ntra 174 ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:) ! NO mask 175 ENDDO 176 ! 177 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! 178 ! 179 IF( kt == nit000 .AND. lwp )THEN 180 WRITE(numout,*) 181 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 80 182 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,*) 183 ! 184 DO jn = 1, ntra 185 DO jj = 1, jpj ! vertical interpolation of T & S 186 DO ji = 1, jpi 187 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 188 zl = fsdept_0(ji,jj,jk) 189 IF( zl < gdept_0(1 ) ) THEN ! above the first level of data 190 ztp(jk) = ptrc(ji,jj,1 ,jn) 191 ELSEIF( zl > gdept_0(jpk) ) THEN ! below the last level of data 192 ztp(jk) = ptrc(ji,jj,jpkm1,jn) 193 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 194 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 195 IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 196 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 197 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi 198 ENDIF 199 END DO 200 ENDIF 201 END DO 202 DO jk = 1, jpkm1 203 ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 204 END DO 205 ptrc(ji,jj,jpk,jn) = 0._wp 206 END DO 207 END DO 208 ENDDO 209 ! 210 ELSE !== z- or zps- coordinate ==! 211 ! 212 DO jn = 1, ntra 213 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:) ! Mask 214 ! 215 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level 216 DO jj = 1, jpj 217 DO ji = 1, jpi 218 ik = mbkt(ji,jj) 219 IF( ik > 1 ) THEN 220 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 221 ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn) 222 ENDIF 223 END DO 224 END DO 132 225 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) 226 ENDDO 227 ! 228 ENDIF 229 ! 230 DO jn = 1, ntra 231 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn) ! multiplicative factor 232 ENDDO 233 ! 234 IF( lwp .AND. kt == nit000 ) THEN 235 DO jn = 1, ntra 236 clndta = TRIM( sf_trcdta(jn)%clvar ) 237 WRITE(numout,*) ''//clndta//' data ' 157 238 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 198 ! 239 WRITE(numout,*)' level = 1' 240 CALL prihre( ptrc(:,:,1 ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 241 WRITE(numout,*)' level = ', jpk/2 242 CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 243 WRITE(numout,*)' level = ', jpkm1 244 CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 245 WRITE(numout,*) 246 ENDDO 247 ENDIF 248 ! 249 IF( .NOT.ln_trcdmp ) THEN !== deallocate data structure ==! 250 ! (data used only for initialisation) 251 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 252 DO jn = 1, ntra 253 DEALLOCATE( sf_trcdta(jn)%fnow ) ! arrays in the structure 254 IF( sf_trcdta(jn)%ln_tint ) DEALLOCATE( sf_trcdta(jn)%fdta ) 255 ENDDO 256 ! 257 ENDIF 258 ! 259 ENDIF 260 ! 199 261 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 262 #else 215 263 !!---------------------------------------------------------------------- 216 264 !! Dummy module NO 3D passive tracer data 217 265 !!---------------------------------------------------------------------- 218 LOGICAL , PUBLIC, PARAMETER :: lk_dtatrc = .FALSE. !: temperature data flag219 266 CONTAINS 220 267 SUBROUTINE trc_dta( kt ) ! Empty routine … … 222 269 END SUBROUTINE trc_dta 223 270 #endif 224 225 271 !!====================================================================== 226 272 END MODULE trcdta
Note: See TracChangeset
for help on using the changeset viewer.
