Changeset 4176
- Timestamp:
- 2013-11-11T12:13:04+01:00 (10 years ago)
- Location:
- branches/2013/dev_CMCC_2013/NEMOGCM
- Files:
-
- 3 deleted
- 9 edited
- 2 copied
-
ARCH/CMCC/arch-athena-xios.fcm (copied) (copied from branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/ARCH/CMCC/arch-athena-xios.fcm)
-
CONFIG/GYRE/cpp_GYRE.fcm (modified) (1 diff)
-
CONFIG/GYRE_BFM/EXP00/namelist (deleted)
-
CONFIG/GYRE_BFM/EXP00/namelist_top (deleted)
-
CONFIG/GYRE_BFM/EXP00/solver.stat (deleted)
-
CONFIG/GYRE_BFM/README (modified) (3 diffs)
-
CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/tranxt.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/step.F90 (modified) (3 diffs)
-
NEMO/TOP_SRC/TRP/trcdmp.F90 (modified) (10 diffs)
-
NEMO/TOP_SRC/par_trc.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/trcbc.F90 (copied) (copied from branches/2013/dev_r3996_CMCC6_topbc/NEMOGCM/NEMO/TOP_SRC/trcbc.F90)
-
NEMO/TOP_SRC/trcdta.F90 (modified) (18 diffs)
-
NEMO/TOP_SRC/trcini.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_CMCC_2013/NEMOGCM/CONFIG/GYRE/cpp_GYRE.fcm
r3695 r4176 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_CMCC_2013/NEMOGCM/CONFIG/GYRE_BFM/README
r3813 r4176 5 5 INFO HELPDESK: info@bfm-community.eu 6 6 WEB SITE: www.bfm-community.eu 7 REVISION DATE: February20137 REVISION DATE: October 2013 8 8 9 9 Please address any technical query to the BFM System Team … … 33 33 Compile NEMO with the BFM 34 34 ----------------------------------------------------------------------- 35 NEMO-BFM is compiled from the BFM configuration script relying on the 36 NEMO FCM compilation environment. This is done to allow BFM users to 37 use new configurations in NEMO that are not part of the NEMO 38 standard distribution code. 39 The BFM configuration shipped with NEMO is GYRE_BFM (see next section) 40 35 41 Make sure that the BFMDIR variable is defined in your environment 36 (ex: export BFMDIR=path/to/bfm) 37 Define the variable NEMODIR pointing to the root of NEMO source code 38 (ex: export NEMODIR=path/to/nemo) 42 and define the variable NEMODIR pointing to the root of NEMO source code 43 It is assumed here that you have expanded the bfm in /home/user/bfm 44 and the root of this NEMO directory in /home/user/nemo then 45 and that you have already adjusted the appropriate ARCHFILE that 46 is used for the NEMO compilation with makenemo in ../../ARCH 39 47 40 Go to the $BFMDIR/build/Configurations/GYRE_BFM directory and read 41 carefully the README file. 42 Altrenatively, execute 43 $BFMDIR/build/bfm_config.sh -h 44 to get information on how to add the appropriate ARCHFILE that 45 is used for the NEMO compilation. 46 The script will generate the BFM code and then launch makenemo 47 to build the executable in this directory. 48 Execute the following commands: 49 >> export BFMDIR=/home/user/bfm 50 >> export NEMODIR=/home/user/nemo 51 >> cd $BFMDIR/build 52 >> ./bfm_config.sh -gcd -p GYRE_BFM 48 53 49 Once the BFM code has been generated the first time, the code can be 50 rebuilt with the following command: 51 ./makenemo -n GYRE_BFM -m ARCHFILE -e $BFMDIR/src/nemo 54 The script will generate (-g) the BFM code, then launch 55 makenemo for compilation (-c) and create the run directory 56 (-d) in $BFMDIR/run. 57 58 to get information on how to use the BFM configuration script run 59 >> ./bfm_config.sh -h 52 60 53 61 ----------------------------------------------------------------------- … … 56 64 The distributed standard test case is GYRE_BFM, a version of GYRE 57 65 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. 66 meant to produce any published result. 67 GYRE_BFM runs with analytical input data only. 68 The namelists for the BFM are not distributed with NEMO but are 69 generated directly by the BFM, in directory $BFMDIR/run/gyre_bfm. 70 The generation of the BFM namelist also copy the required NEMO 71 namelist and namelist_top files to this directory. 72 This is why there are no namelist files found in the standard 73 run directory $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00 74 75 Note for expert users: 76 If a user prefers to work in the NEMO directory than she has to 77 copy the generated namelists there 78 >> cp $BFMDIR/run/gyre_bfm/* $NEMODIR/NEMOGCM/CONFIG/GYRE_BFM/EXP00 79 Once the BFM code has been generated the first time, the code can be 80 also rebuilt with the standard NEMO command: 81 >> ./makenemo -n GYRE_BFM -m ARCHFILE -e $BFMDIR/src/nemo 63 82 64 83 ----------------------------------------------------------------------- 65 84 Other examples 66 85 ----------------------------------------------------------------------- 67 Other couplings with NEMO are available in $BFMDIR/build/Configurations. 86 Other couplings with NEMO are available in $BFMDIR/build/configurations. 87 Run the command 88 >> ./bfm_config.sh -P 89 to get a list of available presets 68 90 Please refer to the README file in each directory for more information. -
branches/2013/dev_CMCC_2013/NEMOGCM/CONFIG/GYRE_BFM/cpp_GYRE_BFM.fcm
r3695 r4176 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_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r3294 r4176 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_CMCC_2013/NEMOGCM/NEMO/OPA_SRC/step.F90
r4175 r4176 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_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r3882 r4176 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_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r3680 r4176 17 17 18 18 IMPLICIT NONE 19 20 ! Passive tracers : Maximum number of tracers. Needed to define data structures 21 ! --------------- 22 INTEGER, PUBLIC, PARAMETER :: jpmaxtrc = 100 19 23 20 24 ! Passive tracers : Total size -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/trcdta.F90
r3882 r4176 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 … … 30 31 INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data 31 32 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, 33 INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 34 REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values 35 TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read) 35 36 36 37 !! * Substitutions … … 43 44 CONTAINS 44 45 45 SUBROUTINE trc_dta_init 46 SUBROUTINE trc_dta_init(ntrc) 46 47 !!---------------------------------------------------------------------- 47 48 !! *** ROUTINE trc_dta_init *** … … 53 54 !!---------------------------------------------------------------------- 54 55 ! 55 INTEGER :: jl, jn ! dummy loop indicies 56 INTEGER,INTENT(IN) :: ntrc ! number of tracers 57 INTEGER :: jl, jn ! dummy loop indices 56 58 INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers 59 INTEGER :: ios ! Local integer output status for namelist read 57 60 CHARACTER(len=100) :: clndta, clntrc 58 61 REAL(wp) :: zfact 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(jp tra) :: sn_trcdta63 REAL(wp) , DIMENSION(jp tra) :: 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(jpmaxtrc) :: sn_trcdta 66 REAL(wp) , DIMENSION(jpmaxtrc) :: 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 ) … … 103 106 END DO 104 107 ! 108 !MAV temporary code for 3.5 105 109 REWIND( numnat ) ! read nattrc 106 110 READ ( numnat, namtrc_dta ) 111 !MAV future code for 3.6 112 ! REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer data 113 ! READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 114 !901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp ) 115 ! 116 ! REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer data 117 ! READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 118 !902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp ) 119 ! WRITE ( numont, namtrc_dta ) 107 120 108 121 IF( lwp ) THEN 109 DO jn = 1, jptra122 DO jn = 1, ntrc 110 123 IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true 111 124 clndta = TRIM( sn_trcdta(jn)%clvar ) … … 129 142 ENDIF 130 143 ! 131 DO jn = 1, jptra144 DO jn = 1, ntrc 132 145 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 133 146 jl = n_trc_index(jn) … … 147 160 ENDIF 148 161 ! 162 DEALLOCATE( slf_i ) ! deallocate local field structure 149 163 IF( nn_timing == 1 ) CALL timing_stop('trc_dta_init') 150 164 ! … … 152 166 153 167 154 SUBROUTINE trc_dta( kt, ptrc )168 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) 155 169 !!---------------------------------------------------------------------- 156 170 !! *** ROUTINE trc_dta *** … … 162 176 !! - ln_trcdmp=F: deallocates the data structure as they are not used 163 177 !! 164 !! ** Action : ptrcpassive tracer data on medl mesh and interpolated at time-step kt178 !! ** Action : sf_dta passive tracer data on medl mesh and interpolated at time-step kt 165 179 !!---------------------------------------------------------------------- 166 180 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 181 TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read 182 REAL(wp) , INTENT(in ) :: zrf_trfac ! multiplication factor 183 ! 184 INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices 170 185 REAL(wp):: zl, zi 171 186 REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace … … 177 192 IF( nb_trcdta > 0 ) THEN 178 193 ! 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 194 CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==! 184 195 ! 185 196 IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==! … … 190 201 ENDIF 191 202 ! 192 DO jn = 1, ntra193 203 DO jj = 1, jpj ! vertical interpolation of T & S 194 204 DO ji = 1, jpi … … 196 206 zl = fsdept_0(ji,jj,jk) 197 207 IF( zl < gdept_0(1 ) ) THEN ! above the first level of data 198 ztp(jk) = ptrc(ji,jj,1 ,jn)208 ztp(jk) = sf_dta(1)%fnow(ji,jj,1) 199 209 ELSEIF( zl > gdept_0(jpk) ) THEN ! below the last level of data 200 ztp(jk) = ptrc(ji,jj,jpkm1,jn)210 ztp(jk) = sf_dta(1)%fnow(ji,jj,jpkm1) 201 211 ELSE ! inbetween : vertical interpolation between jkk & jkk+1 202 212 DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1) 203 213 IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 204 214 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 215 ztp(jk) = sf_dta(1)%fnow(ji,jj,jkk) + ( sf_dta(1)%fnow(ji,jj,jkk+1) - & 216 sf_dta(1)%fnow(ji,jj,jkk) ) * zi 206 217 ENDIF 207 218 END DO … … 209 220 END DO 210 221 DO jk = 1, jpkm1 211 ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord222 sf_dta(1)%fnow(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord 212 223 END DO 213 ptrc(ji,jj,jpk,jn) = 0._wp224 sf_dta(1)%fnow(ji,jj,jpk) = 0._wp 214 225 END DO 215 226 END DO 216 ENDDO217 227 ! 218 228 ELSE !== z- or zps- coordinate ==! 219 229 ! 220 DO jn = 1, ntra 221 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:) ! Mask 230 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask 222 231 ! 223 232 IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level … … 227 236 IF( ik > 1 ) THEN 228 237 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)238 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 239 ENDIF 231 240 END DO 232 241 END DO 233 242 ENDIF 234 ENDDO235 243 ! 236 244 ENDIF 237 245 ! 238 DO jn = 1, ntra 239 ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn) ! multiplicative factor 240 ENDDO 246 sf_dta(1)%fnow(:,:,:) = sf_dta(1)%fnow(:,:,:) * zrf_trfac ! multiplicative factor 241 247 ! 242 248 IF( lwp .AND. kt == nit000 ) THEN 243 DO jn = 1, ntra 244 clndta = TRIM( sf_trcdta(jn)%clvar ) 249 clndta = TRIM( sf_dta(1)%clvar ) 245 250 WRITE(numout,*) ''//clndta//' data ' 246 251 WRITE(numout,*) 247 252 WRITE(numout,*)' level = 1' 248 CALL prihre( ptrc(:,:,1 ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )253 CALL prihre( sf_dta(1)%fnow(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 249 254 WRITE(numout,*)' level = ', jpk/2 250 CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )255 CALL prihre( sf_dta(1)%fnow(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 251 256 WRITE(numout,*)' level = ', jpkm1 252 CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )257 CALL prihre( sf_dta(1)%fnow(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 253 258 WRITE(numout,*) 254 ENDDO 255 ENDIF 256 257 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 258 ! (data used only for initialisation) 259 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 ! 259 ENDIF 260 ENDIF 261 ! 270 262 IF( nn_timing == 1 ) CALL timing_stop('trc_dta') 271 263 ! … … 276 268 !!---------------------------------------------------------------------- 277 269 CONTAINS 278 SUBROUTINE trc_dta( kt ) ! Empty routine270 SUBROUTINE trc_dta( kt, sf_dta, zrf_trfac ) ! Empty routine 279 271 WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 280 272 END SUBROUTINE trc_dta -
branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r3680 r4176 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( nit000, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000 130 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 131 trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:) 132 IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==! 133 ! (data used only for initialisation) 134 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 135 DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure 136 IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta ) 137 ! 138 ENDIF 132 139 ENDIF 133 140 ENDDO 134 CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta,ztrcdta )141 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 135 142 ENDIF 136 143 !
Note: See TracChangeset
for help on using the changeset viewer.
