Changeset 4011 for branches/2013/dev_r3996_CMCC6_topbc
- Timestamp:
- 2013-09-04T18:48:29+02:00 (11 years ago)
- Location:
- branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM
- Files:
-
- 3 deleted
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
r3695 r4011 1 bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 1 bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero -
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/CONFIG/GYRE_BFM/README
r3813 r4011 38 38 (ex: export NEMODIR=path/to/nemo) 39 39 40 Go to the $BFMDIR/build/ Configurations/GYRE_BFM directory and read40 Go to the $BFMDIR/build/configurations/GYRE_BFM directory and read 41 41 carefully the README file. 42 42 Altrenatively, execute … … 48 48 49 49 Once the BFM code has been generated the first time, the code can be 50 rebuilt with the followingcommand:50 also rebuilt with the standard NEMO command: 51 51 ./makenemo -n GYRE_BFM -m ARCHFILE -e $BFMDIR/src/nemo 52 52 … … 56 56 The distributed standard test case is GYRE_BFM, a version of GYRE 57 57 with a full-blown BFM. It is a demnstration simulation and it is not 58 meant to produce any published result. The namelists for the BFM are 59 not distributed with NEMO but are generated directly by the BFM, in 60 directory $BFMDIR/run/GYRE_BFM. The user can either copy the content 61 of $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00 in this directory or the 62 other way around. GYRE_BFM runs with analytical input data only. 58 meant to produce any published result. 59 GYRE_BFM runs with analytical input data only. 60 The namelists for the BFM are not distributed with NEMO but are 61 generated directly by the BFM, in directory $BFMDIR/run/gyre_bfm. 62 The generation of the BFM namelist also copy the required NEMO 63 namelist and namelist_top files to this directory. 64 This is why there are no namelist files found in the standard 65 run directory $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00 66 If a user prefers to work in that directory than she has to 67 copy the generated namelists there 63 68 64 69 ----------------------------------------------------------------------- 65 70 Other examples 66 71 ----------------------------------------------------------------------- 67 Other couplings with NEMO are available in $BFMDIR/build/ Configurations.72 Other couplings with NEMO are available in $BFMDIR/build/configurations. 68 73 Please refer to the README file in each directory for more information. -
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm
r3695 r4011 1 bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_top key_my_trc key_mpp_mpi key_iomput 1 bld::tool::fppkeys key_gyre key_dynspg_flt key_ldfslp key_zdftke key_vectopt_loop key_top key_my_trc key_mpp_mpi key_iomput key_nosignedzero 2 2 inc $BFMDIR/src/nemo/bfm.fcm -
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r3294 r4011 104 104 IF(lwp) WRITE(numout,*) '~~~~~~~' 105 105 ! 106 rbcp = 0.25 * (1. + atfp) * (1. + atfp) * ( 1.- atfp) ! Brown & Campana parameter for semi-implicit hpg106 rbcp = 0.25_wp * (1._wp + atfp) * (1._wp + atfp) * ( 1._wp - atfp) ! Brown & Campana parameter for semi-implicit hpg 107 107 ENDIF 108 108 109 109 ! Update after tracer on domain lateral boundaries 110 110 ! 111 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) ! local domain boundaries (T-point, unchanged sign)112 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )111 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign) 112 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 113 113 ! 114 114 #if defined key_obc … … 124 124 ! set time step size (Euler/Leapfrog) 125 125 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dtra(:) = rdttra(:) ! at nit000 (Euler) 126 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dtra(:) = 2. * rdttra(:) ! at nit000 or nit000+1 (Leapfrog)126 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dtra(:) = 2._wp* rdttra(:) ! at nit000 or nit000+1 (Leapfrog) 127 127 ENDIF 128 128 … … 155 155 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 156 156 DO jk = 1, jpkm1 157 zfact = 1.e0 / r2dtra(jk)157 zfact = 1.e0_wp / r2dtra(jk) 158 158 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 159 159 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact -
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/OPA_SRC/step.F90
r3985 r4011 183 183 tsa(:,:,:,:) = 0.e0 ! set tracer trends to zero 184 184 185 !write(numout,*) "MAV kt",kstp 186 !write(numout,'(a5,3(1x,f21.18))') "INIn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 187 !write(numout,'(a5,3(1x,f21.18))') "INIa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 185 188 IF( ln_asmiau .AND. & 186 189 & ln_trainc ) CALL tra_asm_inc( kstp ) ! apply tracer assimilation increment … … 192 195 IF( lk_bdy ) CALL bdy_tra_dmp( kstp ) ! bdy damping trends 193 196 CALL tra_adv ( kstp ) ! horizontal & vertical advection 197 !write(numout,'(a5,3(1x,f21.18))') "ADVn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 198 !write(numout,'(a5,3(1x,f21.18))') "ADVa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 194 199 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 195 200 CALL tra_ldf ( kstp ) ! lateral mixing 201 !write(numout,'(a5,3(1x,f21.18))') "LDFn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 202 !write(numout,'(a5,3(1x,f21.18))') "LDFa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 196 203 #if defined key_agrif 197 204 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge 198 205 #endif 199 206 CALL tra_zdf ( kstp ) ! vertical mixing and after tracer fields 207 !do jk=1,jpk 208 !write(numout,'(a5,3(1x,f21.18))') "ZDFn:",tsn(5,10,jk,jp_tem),tsn(5,10,jk,jp_sal),tmask(5,10,jk) 209 !write(numout,'(a5,3(1x,f21.18))') "ZDFa:",tsa(5,10,jk,jp_tem),tsa(5,10,jk,jp_sal),ssha(5,10) 210 !end do 200 211 201 212 IF( ln_dynhpg_imp ) THEN ! semi-implicit hpg (time stepping then eos) … … 210 221 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! zps: now hor. derivative 211 222 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 223 !write(numout,'(a5,3(1x,f21.18))') "ZPSn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(24,11) 224 !write(numout,'(a5,3(1x,f21.18))') "ZPSa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 212 225 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 213 226 CALL tra_nxt( kstp ) ! tracer fields at next time step 227 !write(numout,'(a5,3(1x,f21.18))') "NXTn:",tsn(24,11,1,jp_tem),tsn(24,11,1,jp_sal),sshn(25,11) 228 !write(numout,'(a5,3(1x,f21.18))') "NXTa:",tsa(24,11,1,jp_tem),tsa(24,11,1,jp_sal),ssha(24,11) 214 229 ENDIF 215 230 -
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r3882 r4011 85 85 CHARACTER (len=22) :: charout 86 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 87 REAL(wp), POINTER, DIMENSION(:,:,: ,:) :: ztrcdta ! 4D workspace87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 88 88 !!---------------------------------------------------------------------- 89 89 ! … … 98 98 IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 99 99 ! 100 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 101 CALL trc_dta( kt, ztrcdta ) ! read tracer data at nit000 100 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 102 101 ! ! =========== 103 102 DO jn = 1, jptra ! tracer loop … … 108 107 109 108 jl = n_trc_index(jn) 109 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 110 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 110 111 111 112 SELECT CASE ( nn_zdmp_tr ) … … 115 116 DO jj = 2, jpjm1 116 117 DO ji = fs_2, fs_jpim1 ! vector opt. 117 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ,jl) - trb(ji,jj,jk,jn) )118 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 118 119 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 119 120 END DO … … 126 127 DO ji = fs_2, fs_jpim1 ! vector opt. 127 128 IF( avt(ji,jj,jk) <= 5.e-4 ) THEN 128 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ,jl) - trb(ji,jj,jk,jn) )129 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 129 130 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 130 131 ENDIF … … 138 139 DO ji = fs_2, fs_jpim1 ! vector opt. 139 140 IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 140 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk ,jl) - trb(ji,jj,jk,jn) )141 ztra = restotr(ji,jj,jk) * ( ztrcdta(ji,jj,jk) - trb(ji,jj,jk,jn) ) 141 142 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 142 143 END IF … … 156 157 END DO ! tracer loop 157 158 ! ! =========== 158 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta,ztrcdta )159 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 159 160 ENDIF 160 161 ! … … 185 186 ! 186 187 INTEGER :: ji, jj, jk, jn, jl, jc ! dummy loop indicesa 187 REAL(wp), POINTER, DIMENSION(:,:,: ,:) :: ztrcdta ! 4D workspace188 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace 188 189 189 190 !!---------------------------------------------------------------------- … … 267 268 IF(lwp) WRITE(numout,*) 268 269 ! 269 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 270 ! 271 CALL trc_dta( kt , ztrcdta ) ! read tracer data at nittrc000 270 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 272 271 ! 273 272 DO jn = 1, jptra 274 273 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 275 274 jl = n_trc_index(jn) 275 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 276 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 276 277 DO jc = 1, npncts 277 278 DO jk = 1, jpkm1 278 279 DO jj = nctsj1(jc), nctsj2(jc) 279 280 DO ji = nctsi1(jc), nctsi2(jc) 280 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk ,jl) * tmask(ji,jj,jk)281 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk) * tmask(ji,jj,jk) 281 282 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 282 283 ENDDO … … 286 287 ENDIF 287 288 ENDDO 288 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta,ztrcdta )289 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 289 290 ENDIF 290 291 ! -
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r3882 r4011 8 8 !! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90 9 9 !! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation 10 !! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_top … … 28 29 PUBLIC trc_dta_init ! called in trcini.F90 29 30 31 INTEGER , PARAMETER, PUBLIC :: MAXTRC=100 ! maximum number of tracers 30 32 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data 31 33 INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data 32 INTEGER , SAVE 33 REAL(wp) , SAVE, 34 TYPE(FLD), SAVE, 34 INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 35 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values 36 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 35 37 36 38 !! * Substitutions … … 43 45 CONTAINS 44 46 45 SUBROUTINE trc_dta_init 47 SUBROUTINE trc_dta_init(ntrc) 46 48 !!---------------------------------------------------------------------- 47 49 !! *** ROUTINE trc_dta_init *** … … 53 55 !!---------------------------------------------------------------------- 54 56 ! 57 INTEGER,INTENT(IN) :: ntrc 55 58 INTEGER :: jl, jn ! dummy loop indicies 56 59 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers … … 59 62 ! 60 63 CHARACTER(len=100) :: cn_dir 61 TYPE(FLD_N), DIMENSION(jptra) :: slf_i ! array of namelist informations on the fields to read62 TYPE(FLD_N), DIMENSION( jptra) :: sn_trcdta63 REAL(wp) , DIMENSION( jptra) :: rn_trfac ! multiplicative factor for tracer values64 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read 65 TYPE(FLD_N), DIMENSION(MAXTRC) :: sn_trcdta 66 REAL(wp) , DIMENSION(MAXTRC) :: rn_trfac ! multiplicative factor for tracer values 64 67 !! 65 68 NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac … … 71 74 ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0 72 75 ! Compute the number of tracers to be initialised with data 73 ALLOCATE( n_trc_index( jptra), STAT=ierr0 )76 ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 74 77 IF( ierr0 > 0 ) THEN 75 78 CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' ) ; RETURN … … 77 80 nb_trcdta = 0 78 81 n_trc_index(:) = 0 79 DO jn = 1, jptra82 DO jn = 1, ntrc 80 83 IF( ln_trc_ini(jn) ) THEN 81 84 nb_trcdta = nb_trcdta + 1 … … 93 96 ! 94 97 cn_dir = './' ! directory in which the model is executed 95 DO jn = 1, jptra98 DO jn = 1, ntrc 96 99 WRITE( clndta,'("TR_",I1)' ) jn 97 100 clndta = TRIM( clndta ) … … 107 110 108 111 IF( lwp ) THEN 109 DO jn = 1, jptra112 DO jn = 1, ntrc 110 113 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 111 114 clndta = TRIM( sn_trcdta(jn)%clvar ) … … 129 132 ENDIF 130 133 ! 131 DO jn = 1, jptra134 DO jn = 1, ntrc 132 135 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 133 136 jl = n_trc_index(jn) … … 152 155 153 156 154 SUBROUTINE trc_dta( kt, ptrc )157 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) 155 158 !!---------------------------------------------------------------------- 156 159 !! *** ROUTINE trc_dta *** … … 162 165 !! - ln_trcdmp=F: deallocates the data structure as they are not used 163 166 !! 164 !! ** Action : ptrcpassive tracer data on medl mesh and interpolated at time-step kt167 !! ** Action : sf_dta passive tracer data on medl mesh and interpolated at time-step kt 165 168 !!---------------------------------------------------------------------- 166 169 INTEGER , INTENT(in ) :: kt ! ocean time-step 167 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: ptrc ! passive tracer data 168 ! 169 INTEGER :: ji, jj, jk, jl, jn, jkk, ik ! dummy loop indicies 170 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 171 REAL(wp) , INTENT(in ) :: zrf_trfac ! multiplication factor 172 ! 173 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 170 174 REAL(wp):: zl, zi 171 175 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace … … 177 181 IF( nb_trcdta > 0 ) THEN 178 182 ! 179 CALL fld_read( kt, 1, sf_trcdta ) !== read data at kt time step ==! 180 ! 181 DO jn = 1, ntra 182 ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:) ! NO mask 183 ENDDO 183 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 184 184 ! 185 185 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 190 190 ENDIF 191 191 ! 192 DO jn = 1, ntra193 192 DO jj = 1, jpj ! vertical interpolation of T & S 194 193 DO ji = 1, jpi … … 196 195 zl = fsdept_0(ji,jj,jk) 197 196 IF( zl < gdept_0(1 ) ) THEN ! above the first level of data 198 ztp(jk) = ptrc(ji,jj,1 ,jn)197 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) 199 198 ELSEIF( zl > gdept_0(jpk) ) THEN ! below the last level of data 200 ztp(jk) = ptrc(ji,jj,jpkm1,jn)199 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1) 201 200 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 202 201 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 203 202 IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 204 203 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 205 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi 204 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 205 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 206 206 ENDIF 207 207 END DO … … 209 209 END DO 210 210 DO jk = 1, jpkm1 211 ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord211 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 212 212 END DO 213 ptrc(ji,jj,jpk,jn) = 0._wp213 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 214 214 END DO 215 215 END DO 216 ENDDO217 216 ! 218 217 ELSE !== z- or zps- coordinate ==! 219 218 ! 220 DO jn = 1, ntra 221 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:) ! Mask 219 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 222 220 ! 223 221 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level … … 227 225 IF( ik > 1 ) THEN 228 226 zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 229 ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn)227 sf_dta(1)%fnow(ji,jj,ik) = (1.-zl) * sf_dta(1)%fnow(ji,jj,ik) + zl * sf_dta(1)%fnow(ji,jj,ik-1) 230 228 ENDIF 231 229 END DO 232 230 END DO 233 231 ENDIF 234 ENDDO 235 ! 236 ENDIF 237 ! 238 DO jn = 1, ntra 239 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn) ! multiplicative factor 240 ENDDO 232 ! 233 ENDIF 234 ! 235 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac ! multiplicative factor 241 236 ! 242 237 IF( lwp .AND. kt == nit000 ) THEN 243 DO jn = 1, ntra 244 clndta = TRIM( sf_trcdta(jn)%clvar ) 238 clndta = TRIM( sf_dta(1)%clvar ) 245 239 WRITE(numout,*) ''//clndta//' data ' 246 240 WRITE(numout,*) 247 241 WRITE(numout,*)' level = 1' 248 CALL prihre( ptrc(:,:,1 ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )242 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 249 243 WRITE(numout,*)' level = ', jpk/2 250 CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )244 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 251 245 WRITE(numout,*)' level = ', jpkm1 252 CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )246 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 253 247 WRITE(numout,*) 254 ENDDO 255 ENDIF 256 248 ENDIF 257 249 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 258 250 ! (data used only for initialisation) 259 251 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 260 DO jn = 1, ntra 261 DEALLOCATE( sf_trcdta(jn)%fnow ) ! arrays in the structure 262 IF( sf_trcdta(jn)%ln_tint ) DEALLOCATE( sf_trcdta(jn)%fdta ) 263 ENDDO 264 DEALLOCATE( sf_trcdta ) ! the structure itself 265 ! 266 ENDIF 267 ! 268 ENDIF 269 ! 252 DEALLOCATE( sf_dta(1)%fnow ) ! arrays in the structure 253 IF( sf_dta(1)%ln_tint ) DEALLOCATE( sf_dta(1)%fdta ) 254 ! 255 ENDIF 256 ENDIF 257 ! 270 258 IF( nn_timing == 1 ) CALL timing_stop('trc_dta') 271 259 ! … … 276 264 !!---------------------------------------------------------------------- 277 265 CONTAINS 278 SUBROUTINE trc_dta( kt ) ! Empty routine266 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) ! Empty routine 279 267 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 280 268 END SUBROUTINE trc_dta -
branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r3680 r4011 24 24 USE trcini_c14b ! C14 bomb initialisation 25 25 USE trcini_my_trc ! MY_TRC initialisation 26 USE trcdta ! initialisation f orm files26 USE trcdta ! initialisation from files 27 27 USE daymod ! calendar manager 28 28 USE zpshde ! partial step: hor. derivative (zps_hde routine) … … 58 58 INTEGER :: jk, jn, jl ! dummy loop indices 59 59 CHARACTER (len=25) :: charout 60 REAL(wp), POINTER, DIMENSION(:,:,: ,:) :: ztrcdta ! 4D workspace60 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace 61 61 !!--------------------------------------------------------------------- 62 62 ! … … 111 111 ENDIF 112 112 113 IF( ln_trcdta ) CALL trc_dta_init 113 IF( ln_trcdta ) CALL trc_dta_init(jptra) 114 114 115 115 … … 122 122 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 123 123 ! 124 CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) ! Memory allocation 125 ! 126 CALL trc_dta( nit000, ztrcdta ) ! read tracer data at nit000 124 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 127 125 ! 128 126 DO jn = 1, jptra 129 127 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 130 128 jl = n_trc_index(jn) 131 trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * tmask(:,:,:) 129 CALL trc_dta( kt, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 130 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 131 trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:) 132 132 ENDIF 133 133 ENDDO 134 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta,ztrcdta )134 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 135 135 ENDIF 136 136 !
Note: See TracChangeset
for help on using the changeset viewer.