Changeset 2104 for branches/DEV_r2006_merge_TRA_TRC
- Timestamp:
- 2010-09-17T14:35:46+02:00 (14 years ago)
- Location:
- branches/DEV_r2006_merge_TRA_TRC/NEMO
- Files:
-
- 99 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2006_merge_TRA_TRC/NEMO/C1D_SRC/step_c1d.F90
r1465 r2104 160 160 ! N.B. ua, va arrays are used as workspace in this section 161 161 !----------------------------------------------------------------------- 162 ta(:,:,:) = 0.e0 ! set tracer trends to zero 163 sa(:,:,:) = 0.e0 162 tsa(:,:,:,:) = 0.e0 ! set tracer trends to zero 164 163 165 164 CALL tra_sbc ( kstp ) ! surface boundary condition … … 167 166 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 168 167 CALL tra_zdf ( kstp ) ! vertical mixing 169 CALL tra_nxt ( kstp )! tracer fields at next time step170 IF( ln_zdfnpc ) CALL tra_npc ( kstp )! applied non penetrative convective adjustment on (t,s)171 CALL eos( t b,sb, rhd, rhop ) ! now (swap=before) in situ density for dynhpg module168 CALL tra_nxt ( kstp ) ! tracer fields at next time step 169 IF( ln_zdfnpc ) CALL tra_npc ( kstp ) ! applied non penetrative convective adjustment on (t,s) 170 CALL eos( tsb, rhd, rhop ) ! now (swap=before) in situ density for dynhpg module 172 171 173 172 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/DEV_r2006_merge_TRA_TRC/NEMO/NST_SRC/agrif_user.F90
r2082 r2104 1 1 #if defined key_agrif 2 2 !!---------------------------------------------------------------------- 3 !! OPA 9.0 , LOCEAN-IPSL (2006)3 !! NEMO/NST 3.3 , LOCEAN-IPSL (2010) 4 4 !! $Id$ 5 5 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 55 55 END SUBROUTINE Agrif_InitWorkspace 56 56 57 #if ! defined key_off _tra57 #if ! defined key_offline 58 58 59 59 SUBROUTINE Agrif_InitValues -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DIA/diaar5.F90
r2082 r2104 4 4 !! AR5 diagnostics 5 5 !!====================================================================== 6 !! History : 3.2 ! 2009-11 (S. Masson) Original code 6 !! History : 3.2 ! 2009-11 (S. Masson) Original code 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_diaar5 … … 10 11 !! 'key_diaar5' : activate ar5 diagnotics 11 12 !!---------------------------------------------------------------------- 12 !! exa_mpl : liste of module subroutine (caution, never use the 13 !! exa_mpl_init : name of the module for a routine) 14 !! exa_mpl_stp : Please try to use 3 letter block for routine names 13 !! dia_ar5 : AR5 diagnostics 14 !! dia_ar5_init : initialisation of AR5 diagnostics 15 15 !!---------------------------------------------------------------------- 16 16 USE oce ! ocean dynamics and active tracers … … 37 37 # include "domzgr_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)40 !! $Id$ 39 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- … … 48 48 !! *** ROUTINE dia_ar5 *** 49 49 !! 50 !! ** Purpose : Brief description of the routine 51 !! 52 !! ** Method : description of the methodoloy used to achieve the 53 !! objectives of the routine. Be as clear as possible! 54 !! 55 !! ** Action : - first action (share memory array/varible modified 56 !! in this routine 57 !! - second action ..... 58 !! - ..... 59 !! 60 !! References : Author et al., Short_name_review, Year 61 !! Give references if exist otherwise suppress these lines 50 !! ** Purpose : compute and output some AR5 diagnostics 51 !! 62 52 !!---------------------------------------------------------------------- 63 53 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 155 145 !! *** ROUTINE dia_ar5_init *** 156 146 !! 157 !! ** Purpose : initialization of .... 158 !! 159 !! ** Method : blah blah blah ... 160 !! 161 !! ** input : Namlist namexa 162 !! 163 !! ** Action : ... 147 !! ** Purpose : initialization for AR5 diagnostic computation 148 !! 164 149 !!---------------------------------------------------------------------- 165 150 INTEGER :: inum … … 206 191 !! Default option : NO diaar5 207 192 !!---------------------------------------------------------------------- 208 209 193 LOGICAL, PUBLIC, PARAMETER :: lk_diaar5 = .FALSE. ! coupled flag 210 211 194 CONTAINS 212 195 SUBROUTINE dia_ar5_init ! Dummy routine 196 END SUBROUTINE dia_ar5_init 213 197 SUBROUTINE dia_ar5( kt ) ! Empty routine 214 INTEGER , INTENT( in ) :: kt ! ocean time-step index198 INTEGER :: kt 215 199 WRITE(*,*) 'dia_ar5: You should not have seen this print! error?', kt 216 200 END SUBROUTINE dia_ar5 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DTA/dtasal.F90
r1951 r2104 69 69 !! * Local declarations 70 70 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 71 INTEGER :: imois, iman, i15 , ik ! temporary integers 72 INTEGER :: ierror 71 INTEGER :: ik, ierror ! temporary integers 73 72 #if defined key_tradmp 74 73 INTEGER :: il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 75 74 #endif 76 REAL(wp):: z xy, zl75 REAL(wp):: zl 77 76 #if defined key_orca_lev10 78 77 INTEGER :: ikr, ikw, ikt, jjk 79 78 REAL(wp):: zfac 80 79 #endif 81 REAL(wp), DIMENSION(jpk) :: zsaldta! auxiliary array for interpolation80 REAL(wp), DIMENSION(jpk) :: zsaldta ! auxiliary array for interpolation 82 81 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 83 82 TYPE(FLD_N) :: sn_sal -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DTA/dtatem.F90
r1951 r2104 74 74 !! * Local declarations 75 75 INTEGER :: ji, jj, jk, jl, jkk ! dummy loop indicies 76 INTEGER :: imois, iman, i15 , ik ! temporary integers 77 INTEGER :: ierror 76 INTEGER :: ik, ierror ! temporary integers 78 77 #if defined key_tradmp 79 78 INTEGER :: il0, il1, ii0, ii1, ij0, ij1 ! temporary integers 80 79 #endif 81 REAL(wp):: z xy, zl80 REAL(wp):: zl 82 81 #if defined key_orca_lev10 83 82 INTEGER :: ikr, ikw, ikt, jjk -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynadv.F90
r2027 r2104 4 4 !! Ocean active tracers: advection scheme control 5 5 !!============================================================================== 6 !! History : 9.0 ! 06-11 (G. Madec) Original code 6 !! History : 1.0 ! 2006-11 (G. Madec) Original code 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 7 8 !!---------------------------------------------------------------------- 8 9 9 10 !!---------------------------------------------------------------------- 10 11 !! dyn_adv : compute the momentum advection trend 11 !! dyn_adv_ ctl: control the different options of advection scheme12 !! dyn_adv_init : control the different options of advection scheme 12 13 !!---------------------------------------------------------------------- 13 14 USE dom_oce ! ocean space and time domain … … 25 26 PUBLIC dyn_adv_init ! routine called by opa module 26 27 27 LOGICAL, PUBLIC :: ln_dynadv_vec = .TRUE. ! vector form flag28 LOGICAL, PUBLIC :: ln_dynadv_cen2 = .FALSE. ! flux form - 2nd order centered scheme flag29 LOGICAL, PUBLIC :: ln_dynadv_ubs = .FALSE. ! flux form - 3rd order UBS scheme flag28 LOGICAL, PUBLIC :: ln_dynadv_vec = .TRUE. !: vector form flag 29 LOGICAL, PUBLIC :: ln_dynadv_cen2 = .FALSE. !: flux form - 2nd order centered scheme flag 30 LOGICAL, PUBLIC :: ln_dynadv_ubs = .FALSE. !: flux form - 3rd order UBS scheme flag 30 31 31 32 INTEGER :: nadv ! choice of the formulation and scheme for the advection … … 35 36 # include "vectopt_loop_substitute.h90" 36 37 !!---------------------------------------------------------------------- 37 !! OPA 9.0 , LOCEAN-IPSL (2006)38 !! $Id$ 38 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 39 !! $Id$ 39 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 40 41 !!---------------------------------------------------------------------- … … 84 85 !!---------------------------------------------------------------------- 85 86 INTEGER :: ioptio 86 87 !! 87 88 NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs 88 89 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynhpg.F90
r2027 r2104 4 4 !! Ocean dynamics: hydrostatic pressure gradient trend 5 5 !!====================================================================== 6 !! History : 1.0 !87-09 (P. Andrich, M.-A. Foujols) hpg_zco: Original code7 !! 5.0 ! 91-11 (G. Madec)8 !! 7.0 ! 96-01 (G. Madec) hpg_sco: Original code for s-coordinates9 !! 8.0 ! 97-05 (G. Madec) split dynber into dynkeg and dynhpg10 !! 8.5 ! 02-07 (G. Madec) F90: Free form and module11 !! 8.5 ! 02-08 (A. Bozec) hpg_zps: Original code12 !! 9.0 !05-10 (A. Beckmann, B.W. An) various s-coordinate options6 !! History : OPA ! 1987-09 (P. Andrich, M.-A. Foujols) hpg_zco: Original code 7 !! 5.0 ! 1991-11 (G. Madec) 8 !! 7.0 ! 1996-01 (G. Madec) hpg_sco: Original code for s-coordinates 9 !! 8.0 ! 1997-05 (G. Madec) split dynber into dynkeg and dynhpg 10 !! 8.5 ! 2002-07 (G. Madec) F90: Free form and module 11 !! 8.5 ! 2002-08 (A. Bozec) hpg_zps: Original code 12 !! NEMO 1.0 ! 2005-10 (A. Beckmann, B.W. An) various s-coordinate options 13 13 !! Original code for hpg_ctl, hpg_hel hpg_wdj, hpg_djc, hpg_rot 14 !! 9.0 ! 05-11 (G. Madec) style & small optimisation 14 !! - ! 2005-11 (G. Madec) style & small optimisation 15 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 15 16 !!---------------------------------------------------------------------- 16 17 … … 18 19 !! dyn_hpg : update the momentum trend with the now horizontal 19 20 !! gradient of the hydrostatic pressure 20 !! 21 !! dyn_hpg_init : initialisation and control of options 21 22 !! hpg_zco : z-coordinate scheme 22 23 !! hpg_zps : z-coordinate plus partial steps (interpolation) … … 40 41 41 42 PUBLIC dyn_hpg ! routine called by step module 42 PUBLIC 43 PUBLIC dyn_hpg_init ! routine called by opa module 43 44 44 45 ! !!* Namelist namdyn_hpg : hydrostatic pressure gradient … … 60 61 # include "vectopt_loop_substitute.h90" 61 62 !!---------------------------------------------------------------------- 62 !! OPA 9.0 , LOCEAN-IPSL (2005)63 !! $Id$ 63 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 64 !! $Id$ 64 65 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 65 66 !!---------------------------------------------------------------------- … … 109 110 110 111 111 SUBROUTINE hpg_init112 !!---------------------------------------------------------------------- 113 !! *** ROUTINE hpg_init ***112 SUBROUTINE dyn_hpg_init 113 !!---------------------------------------------------------------------- 114 !! *** ROUTINE dyn_hpg_init *** 114 115 !! 115 116 !! ** Purpose : initializations for the hydrostatic pressure gradient … … 121 122 INTEGER :: ioptio = 0 ! temporary integer 122 123 !! 123 !NAMELIST/namdyn_hpg/ ln_hpg_zco , ln_hpg_zps , ln_hpg_sco, ln_hpg_hel, &124 !& ln_hpg_wdj , ln_hpg_djc , ln_hpg_rot, rn_gamma , &125 !& ln_dynhpg_imp, nn_dynhpg_rst126 !!---------------------------------------------------------------------- 127 128 ! REWIND ( numnam ) ! Namelist namdyn_hpg : already read in opa.F90 module 129 ! READ( numnam, namdyn_hpg )130 131 IF(lwp) THEN 124 NAMELIST/namdyn_hpg/ ln_hpg_zco , ln_hpg_zps , ln_hpg_sco, ln_hpg_hel, & 125 & ln_hpg_wdj , ln_hpg_djc , ln_hpg_rot, rn_gamma , & 126 & ln_dynhpg_imp, nn_dynhpg_rst 127 !!---------------------------------------------------------------------- 128 ! 129 REWIND( numnam ) ! Read Namelist namdyn_hpg 130 READ ( numnam, namdyn_hpg ) 131 ! 132 IF(lwp) THEN ! Control print 132 133 WRITE(numout,*) 133 WRITE(numout,*) 'dyn_hpg : hydrostatic pressure gradient'134 WRITE(numout,*) '~~~~~~~ '134 WRITE(numout,*) 'dyn_hpg_init : hydrostatic pressure gradient initialisation' 135 WRITE(numout,*) '~~~~~~~~~~~~' 135 136 WRITE(numout,*) ' Namelist namdyn_hpg : choice of hpg scheme' 136 137 WRITE(numout,*) ' z-coord. - full steps ln_hpg_zco = ', ln_hpg_zco … … 145 146 WRITE(numout,*) ' add in restart dynhpg semi-implicit variable nn_dynhpg_rst = ', nn_dynhpg_rst 146 147 ENDIF 147 148 IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no adding dynhpg implicit variables in restart 149 150 IF( lk_vvl .AND. .NOT. ln_hpg_sco ) THEN 151 CALL ctl_stop( 'hpg_ctl : variable volume key_vvl compatible only with the standard jacobian formulation hpg_sco') 152 ENDIF 153 148 ! 149 IF( .NOT. ln_dynhpg_imp ) nn_dynhpg_rst = 0 ! force no additional dynhpg implicit variables in restart file 150 ! 151 IF( lk_vvl .AND. .NOT. ln_hpg_sco ) & 152 & CALL ctl_stop( 'dyn_hpg_init : variable volume key_vvl require the standard jacobian formulation hpg_sco') 153 ! 154 154 ! ! Set nhpg from ln_hpg_... flags 155 155 IF( ln_hpg_zco ) nhpg = 0 … … 160 160 IF( ln_hpg_djc ) nhpg = 5 161 161 IF( ln_hpg_rot ) nhpg = 6 162 162 ! 163 163 ! ! Consitency check 164 164 ioptio = 0 … … 171 171 IF( ln_hpg_rot ) ioptio = ioptio + 1 172 172 IF ( ioptio /= 1 ) CALL ctl_stop( ' NO or several hydrostatic pressure gradient options used' ) 173 174 ! 175 END SUBROUTINE hpg_init 173 ! 174 END SUBROUTINE dyn_hpg_init 176 175 177 176 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynldf.F90
r2027 r2104 8 8 9 9 !!---------------------------------------------------------------------- 10 !! dyn_ldf : update the dynamics trend with the lateral diffusion11 !! dyn_ldf_ ctl: initialization, namelist read, and parameters control10 !! dyn_ldf : update the dynamics trend with the lateral diffusion 11 !! dyn_ldf_init : initialization, namelist read, and parameters control 12 12 !!---------------------------------------------------------------------- 13 13 USE oce ! ocean dynamics and tracers … … 31 31 32 32 PUBLIC dyn_ldf ! called by step module 33 PUBLIC dyn_ldf_init ! called by opa module33 PUBLIC dyn_ldf_init ! called by opa module 34 34 35 35 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_dynldf_... namlist logicals) … … 38 38 # include "domzgr_substitute.h90" 39 39 # include "vectopt_loop_substitute.h90" 40 !!---------------------------------------------------------------------- -----------41 !! OPA 9.0 , LOCEAN-IPSL (2005)40 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 42 !! $Id$ 43 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynvor.F90
r2027 r2104 14 14 !! 2.0 ! 2006-11 (G. Madec) flux form advection: add metric term 15 15 !! 3.2 ! 2009-04 (R. Benshila) vvl: correction of een scheme 16 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 16 17 !!---------------------------------------------------------------------- 17 18 18 19 !!---------------------------------------------------------------------- 19 !! dyn_vor : Update the momentum trend with the vorticity trend20 !! vor_ens : enstrophy conserving scheme (ln_dynvor_ens=T)21 !! vor_ene : energy conserving scheme (ln_dynvor_ene=T)22 !! vor_mix : mixed enstrophy/energy conserving (ln_dynvor_mix=T)23 !! vor_een : energy and enstrophy conserving (ln_dynvor_een=T)24 !! vor_ctl: set and control of the different vorticity option20 !! dyn_vor : Update the momentum trend with the vorticity trend 21 !! vor_ens : enstrophy conserving scheme (ln_dynvor_ens=T) 22 !! vor_ene : energy conserving scheme (ln_dynvor_ene=T) 23 !! vor_mix : mixed enstrophy/energy conserving (ln_dynvor_mix=T) 24 !! vor_een : energy and enstrophy conserving (ln_dynvor_een=T) 25 !! dyn_vor_init : set and control of the different vorticity option 25 26 !!---------------------------------------------------------------------- 26 27 USE oce ! ocean dynamics and tracers … … 37 38 38 39 PUBLIC dyn_vor ! routine called by step.F90 39 PUBLIC 40 PUBLIC dyn_vor_init ! routine called by opa.F90 40 41 41 42 ! !!* Namelist namdyn_vor: vorticity term … … 54 55 # include "vectopt_loop_substitute.h90" 55 56 !!---------------------------------------------------------------------- 56 !! NEMO/OPA 3, 2 , LOCEAN-IPSL (2009)57 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 57 58 !! $Id$ 58 59 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 636 637 637 638 638 SUBROUTINE vor_init639 SUBROUTINE dyn_vor_init 639 640 !!--------------------------------------------------------------------- 640 !! *** ROUTINE vor_init ***641 !! *** ROUTINE dyn_vor_init *** 641 642 !! 642 643 !! ** Purpose : Control the consistency between cpp options for … … 652 653 IF(lwp) THEN ! Namelist print 653 654 WRITE(numout,*) 654 WRITE(numout,*) 'dyn :vor_init : vorticity term : read namelist and control the consistency'655 WRITE(numout,*) '~~~~~~~~~~~ '655 WRITE(numout,*) 'dyn_vor_init : vorticity term : read namelist and control the consistency' 656 WRITE(numout,*) '~~~~~~~~~~~~' 656 657 WRITE(numout,*) ' Namelist namdyn_vor : oice of the vorticity term scheme' 657 658 WRITE(numout,*) ' energy conserving scheme ln_dynvor_ene = ', ln_dynvor_ene … … 699 700 ENDIF 700 701 ! 701 END SUBROUTINE vor_init702 END SUBROUTINE dyn_vor_init 702 703 703 704 !!============================================================================== -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DYN/dynzdf.F90
r2027 r2104 4 4 !! Ocean dynamics : vertical component of the momentum mixing trend 5 5 !!============================================================================== 6 !! History : 9.0 ! 05-11 (G. Madec) Original code 6 !! History : 1.0 ! 2005-11 (G. Madec) Original code 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 7 8 !!---------------------------------------------------------------------- 8 9 9 10 !!---------------------------------------------------------------------- 10 11 !! dyn_zdf : Update the momentum trend with the vertical diffusion 11 !! zdf_ctl: initializations of the vertical diffusion scheme12 !! dyn_zdf_init : initializations of the vertical diffusion scheme 12 13 !!---------------------------------------------------------------------- 13 14 USE oce ! ocean dynamics and tracers variables … … 30 31 PUBLIC dyn_zdf_init ! routine called by opa.F90 31 32 32 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used 33 ! ! defined from ln_zdf... namlist logicals) 34 35 REAL(wp) :: r2dt ! time-step, = 2 rdttra 36 ! ! except at nit000 (=rdttra) if neuler=0 33 INTEGER :: nzdf = 0 ! type vertical diffusion algorithm used, defined from ln_zdf... namlist logicals 34 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 37 35 38 36 !! * Substitutions … … 41 39 # include "vectopt_loop_substitute.h90" 42 40 !!---------------------------------------------------------------------- 43 !! OPA 9.0 , LOCEAN-IPSL (2005)41 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 44 42 !! $Id$ 45 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 60 58 61 59 ! ! set time step 62 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restartingwith Euler time stepping)63 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2. * rdt! = 2 rdttra (leapfrog)60 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 61 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 64 62 ENDIF 65 63 … … 71 69 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 72 70 ! 73 CASE ( 0 ) ; CALL dyn_zdf_exp 74 CASE ( 1 ) ; CALL dyn_zdf_imp 71 CASE ( 0 ) ; CALL dyn_zdf_exp( kt, r2dt ) ! explicit scheme 72 CASE ( 1 ) ; CALL dyn_zdf_imp( kt, r2dt ) ! implicit scheme 75 73 ! 76 74 CASE ( -1 ) ! esopa: test all possibility with control print 77 CALL dyn_zdf_exp 75 CALL dyn_zdf_exp( kt, r2dt ) 78 76 CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf0 - Ua: ', mask1=umask, & 79 77 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 80 CALL dyn_zdf_imp 78 CALL dyn_zdf_imp( kt, r2dt ) 81 79 CALL prt_ctl( tab3d_1=ua, clinfo1=' zdf1 - Ua: ', mask1=umask, & 82 80 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) … … 108 106 USE zdfkpp 109 107 !!---------------------------------------------------------------------- 110 108 ! 111 109 ! Choice from ln_zdfexp read in namelist in zdfini 112 110 IF( ln_zdfexp ) THEN ; nzdf = 0 ! use explicit scheme 113 111 ELSE ; nzdf = 1 ! use implicit scheme 114 112 ENDIF 115 113 ! 116 114 ! Force implicit schemes 117 115 IF( lk_zdftke_old .OR. lk_zdftke .OR. lk_zdfkpp ) nzdf = 1 ! TKE or KPP physics 118 116 IF( ln_dynldf_iso ) nzdf = 1 ! iso-neutral lateral physics 119 117 IF( ln_dynldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 120 118 ! 121 119 IF( lk_esopa ) nzdf = -1 ! Esopa key: All schemes used 122 120 ! 123 121 IF(lwp) THEN ! Print the choice 124 122 WRITE(numout,*) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/FLO/floats.F90
r2027 r2104 107 107 WRITE(*,*) 'flo_stp: You should not have seen this print! error?', kt 108 108 END SUBROUTINE flo_stp 109 SUBROUTINE flo_init ! Empty routine 110 END SUBROUTINE flo_init 109 111 #endif 110 112 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/IOM/restart.F90
r2082 r2104 4 4 !! Ocean restart : write the ocean restart file 5 5 !!====================================================================== 6 !! History : !99-11 (M. Imbard) Original code7 !! 8.5 !02-08 (G. Madec) F90: Free form8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization9 !! 9.0 ! 06-07 (S. Masson) use IOM for restart6 !! History : OPA ! 1999-11 (M. Imbard) Original code 7 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form 8 !! 2.0 ! 2006-07 (S. Masson) use IOM for restart 9 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 10 10 !!---------------------------------------------------------------------- 11 11 … … 26 26 USE zdfmxl ! mixed layer depth 27 27 USE trdmld_oce ! ocean active mixed layer tracers trends variables 28 #if defined key_zdfkpp 29 USE traswap 30 #endif 28 USE traswp ! swap from 4D T-S to 3D T & S and vice versa 29 31 30 IMPLICIT NONE 32 31 PRIVATE … … 36 35 PUBLIC rst_read ! routine called by opa module 37 36 38 LOGICAL, PUBLIC :: lrst_oce = .FALSE. 39 INTEGER, PUBLIC :: numror, numrow 37 LOGICAL, PUBLIC :: lrst_oce = .FALSE. !: logical to control the oce restart write 38 INTEGER, PUBLIC :: numror, numrow !: logical unit for cean restart (read and write) 40 39 41 40 !! * Substitutions 42 41 # include "vectopt_loop_substitute.h90" 43 42 !!---------------------------------------------------------------------- 44 !! OPA 9.0 , LOCEAN-IPSL (2006)43 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 45 44 !! $Id$ 46 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 109 108 !! 110 109 !! ** Method : Write in numrow when kt == nitrst in NetCDF 111 !! file, save fields which are necessary for restart110 !! file, save fields which are necessary for restart 112 111 !!---------------------------------------------------------------------- 113 112 INTEGER, INTENT(in) :: kt ! ocean time-step … … 135 134 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 136 135 #if defined key_zdfkpp 137 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd)136 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 138 137 #endif 139 138 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/LDF/ldfslp.F90
r2027 r2104 616 616 WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1) 617 617 END SUBROUTINE ldf_slp 618 SUBROUTINE ldf_slp_init ! Dummy routine 619 END SUBROUTINE ldf_slp_init 618 620 #endif 619 621 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/eosbn2.F90
r2083 r2104 16 16 !! - ! 2003-08 (G. Madec) F90, free form 17 17 !! 3.0 ! 2006-08 (G. Madec) add tfreez function 18 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 18 19 !!---------------------------------------------------------------------- 19 20 … … 61 62 # include "vectopt_loop_substitute.h90" 62 63 !!---------------------------------------------------------------------- 63 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)64 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 64 65 !! $Id$ 65 66 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv.F90
r2082 r2104 5 5 !!============================================================================== 6 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code 7 !! 3. 0 ! 2008-01(C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport7 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 8 8 !!---------------------------------------------------------------------- 9 9 … … 50 50 !!---------------------------------------------------------------------- 51 51 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 52 !! $Id$ 52 !! $Id$ 53 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 54 54 !!---------------------------------------------------------------------- … … 67 67 !! 68 68 INTEGER :: jk ! dummy loop index 69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective transport69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! 3D workspace: effective transport 70 70 !!---------------------------------------------------------------------- 71 71 ! ! set time step … … 135 135 !!---------------------------------------------------------------------- 136 136 INTEGER :: ioptio 137 137 !! 138 138 NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, & 139 139 & ln_traadv_muscl, ln_traadv_muscl2, & -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2082 r2104 15 15 16 16 !!---------------------------------------------------------------------- 17 !! tra_adv_cen2 : update the tracer trend with the horizontal and 18 !! vertical advection trends using a seconder order 19 !! ups_orca_set : allow mixed upstream/centered scheme in specific 20 !! area (set for orca 2 and 4 only) 17 !! tra_adv_cen2 : update the tracer trend with the advection trends using a 2nd order centered scheme 18 !! ups_orca_set : allow mixed upstream/centered scheme in specific area (set for orca 2 and 4 only) 21 19 !!---------------------------------------------------------------------- 22 20 USE oce, ONLY: tsn ! now ocean temperature and salinity … … 115 113 USE oce , zwy => va ! use va as workspace 116 114 !! 117 INTEGER , INTENT(in ):: kt ! ocean time-step index118 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)119 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components120 INTEGER , INTENT(in ) :: kjpt ! number of tracers121 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt):: ptb, ptn ! before and now tracer fields122 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend115 INTEGER , INTENT(in ) :: kt ! ocean time-step index 116 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 117 INTEGER , INTENT(in ) :: kjpt ! number of tracers 118 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 119 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 120 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 123 121 !! 124 122 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 136 134 137 135 138 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN136 IF( kt == nit000 ) THEN 139 137 IF(lwp) WRITE(numout,*) 140 138 IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype 141 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ Vector optimization case'139 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ ' 142 140 IF(lwp) WRITE(numout,*) 143 141 ! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r2082 r2104 4 4 !! Ocean tracers: advection trend - eddy induced velocity 5 5 !!====================================================================== 6 !! History : 9.0 !05-11 (G. Madec) Original code, from traldf and zdf _iso7 !! 3.3 ! 10-05 (C. Ethe, G. Madec) merge TRC-TRA6 !! History : 1.0 ! 2005-11 (G. Madec) Original code, from traldf and zdf _iso 7 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_traldf_eiv || defined key_esopa 10 10 !!---------------------------------------------------------------------- 11 11 !! 'key_traldf_eiv' rotation of the lateral mixing tensor 12 !!----------------------------------------------------------------------13 12 !!---------------------------------------------------------------------- 14 13 !! tra_ldf_iso : update the tracer trend with the horizontal component … … 40 39 # include "vectopt_loop_substitute.h90" 41 40 !!---------------------------------------------------------------------- 42 !! OPA 9.0 , LOCEAN-IPSL (2006)43 !! $Id$ 41 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 !! $Id$ 44 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 45 44 !!---------------------------------------------------------------------- … … 65 64 !! ** Action : - add to p.n the eiv component 66 65 !!---------------------------------------------------------------------- 67 INTEGER , INTENT(in ) :: kt! ocean time-step index68 CHARACTER(len=3) , INTENT(in) :: cdtype! =TRA or TRC (tracer indicator)69 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pun! in : 3 ocean velocity components70 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pvn! out: 3 ocean velocity components71 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pwn! increased by the eiv66 INTEGER , INTENT(in ) :: kt ! ocean time-step index 67 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 68 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pun ! in : 3 ocean velocity components 69 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvn ! out: 3 ocean velocity components 70 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pwn ! increased by the eiv 72 71 !! 73 72 INTEGER :: ji, jj, jk ! dummy loop indices 74 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! temporary scalar75 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! " "76 REAL(wp), DIMENSION(jpi,jpj) :: zu_eiv, zv_eiv, zw_eiv ! " "73 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 74 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 75 REAL(wp), DIMENSION(jpi,jpj) :: zu_eiv, zv_eiv, zw_eiv ! 2D workspace 77 76 # if defined key_diaeiv 78 REAL(wp) :: zztmp ! " "79 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! " "77 REAL(wp) :: zztmp ! local scalar 78 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 80 79 # endif 81 80 !!---------------------------------------------------------------------- 82 81 83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN82 IF( kt == nit000 ) THEN 84 83 IF(lwp) WRITE(numout,*) 85 84 IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :' … … 95 94 96 95 zu_eiv(:,:) = 0.e0 ; zv_eiv(:,:) = 0.e0 ; zw_eiv(:,:) = 0.e0 96 97 97 ! ================= 98 98 DO jk = 1, jpkm1 ! Horizontal slab … … 188 188 CONTAINS 189 189 SUBROUTINE tra_adv_eiv( kt, pun, pvn, pwn, cdtype ) ! Empty routine 190 INTEGER , INTENT(in ) :: kt ! ocean time-step index191 CHARACTER(len=3) , INTENT(in) :: cdtype ! =TRA or TRC (tracer indicator)190 INTEGER :: kt 191 CHARACTER(len=3) :: cdtype 192 192 REAL, DIMENSION(:,:,:) :: pun, pvn, pwn 193 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt 194 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', cdtype 193 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype 195 194 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 196 195 END SUBROUTINE tra_adv_eiv -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r2083 r2104 65 65 USE oce , zwy => va ! use va as workspace 66 66 !! 67 INTEGER , INTENT(in ):: kt ! ocean time-step index68 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)69 INTEGER , INTENT(in ):: kjpt ! number of tracers70 REAL(wp) , INTENT(in ), DIMENSION(jpk):: p2dt ! vertical profile of tracer time-step71 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk):: pun, pvn, pwn ! 3 ocean velocity components72 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields73 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend67 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 71 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 72 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before tracer field 73 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 74 74 !! 75 75 INTEGER :: ji, jj, jk, jn ! dummy loop indices 76 REAL(wp) :: zu, z0u, zzwx 77 REAL(wp) :: zv, z0v, zzwy 78 REAL(wp) :: zw, z0w 76 REAL(wp) :: zu, z0u, zzwx ! local scalar 77 REAL(wp) :: zv, z0v, zzwy ! - - 78 REAL(wp) :: zw, z0w ! - - 79 79 REAL(wp) :: ztra, zbtr, zdt, zalpha 80 80 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy ! 3D workspace 81 81 !!---------------------------------------------------------------------- 82 82 83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN83 IF( kt == nit000 ) THEN 84 84 WRITE(numout,*) 85 85 WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2083 r2104 28 28 PRIVATE 29 29 30 !! * Accessibility 31 PUBLIC tra_adv_muscl2 ! routine called by step.F90 30 PUBLIC tra_adv_muscl2 ! routine called by step.F90 32 31 33 32 LOGICAL :: l_trd ! flag to compute trends … … 61 60 !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 62 61 !!---------------------------------------------------------------------- 63 !!* Module used64 62 USE oce , zwx => ua ! use ua as workspace 65 63 USE oce , zwy => va ! use va as workspace 66 !! * Arguments67 INTEGER , INTENT(in ):: kt ! ocean time-step index68 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)69 INTEGER , INTENT(in ):: kjpt ! number of tracers70 REAL(wp) , INTENT(in ), DIMENSION(jpk):: p2dt ! vertical profile of tracer time-step71 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk):: pun, pvn, pwn ! 3 ocean velocity components72 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before andnow tracer fields73 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend74 !! * Local declarations64 !! 65 INTEGER , INTENT(in ) :: kt ! ocean time-step index 66 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 67 INTEGER , INTENT(in ) :: kjpt ! number of tracers 68 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 69 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 70 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before & now tracer fields 71 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 72 !! 75 73 INTEGER :: ji, jj, jk, jn ! dummy loop indices 76 REAL(wp) :: zu, z0u, zzwx 77 REAL(wp) :: zv, z0v, zzwy 78 REAL(wp) :: zw, z0w 74 REAL(wp) :: zu, z0u, zzwx ! local scalar 75 REAL(wp) :: zv, z0v, zzwy ! - - 76 REAL(wp) :: zw, z0w ! - - 79 77 REAL(wp) :: ztra, zbtr, zdt, zalpha 80 78 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy ! 3D workspace 81 79 !!---------------------------------------------------------------------- 82 80 83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN81 IF( kt == nit000 ) THEN 84 82 WRITE(numout,*) 85 83 WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype … … 90 88 ENDIF 91 89 92 ! 90 ! ! =========== 93 91 DO jn = 1, kjpt ! tracer loop 94 92 ! ! =========== … … 181 179 END DO 182 180 END DO 183 184 ! ! lateral boundary conditions on zwx, zwy (changed sign) 185 CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) 181 CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! lateral boundary condition (changed sign) 182 186 183 ! Tracer flux divergence at t-point added to the general trend 187 184 DO jk = 1, jpkm1 … … 278 275 END DO 279 276 END DO 280 281 ! Compute & add the vertical advective trend 282 DO jk = 1, jpkm1 277 ! 278 DO jk = 1, jpkm1 ! Compute & add the vertical advective trend 283 279 DO jj = 2, jpjm1 284 280 DO ji = fs_2, fs_jpim1 ! vector opt. … … 291 287 END DO 292 288 END DO 293 294 ! Save the vertical advective trends for diagnostic 295 ! ------------------------------------------------- 296 ! ! trend diagnostics (contribution of upstream fluxes) 289 ! ! trend diagnostics (contribution of upstream fluxes) 297 290 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 298 291 ! 299 END DO292 END DO 300 293 ! 301 294 END SUBROUTINE tra_adv_muscl2 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2083 r2104 9 9 10 10 !!---------------------------------------------------------------------- 11 !! tra_adv_qck 12 !! 13 !! tra_adv_qck_i : 14 !! tra_adv_qck_j : 11 !! tra_adv_qck : update the tracer trend with the horizontal advection 12 !! trends using a 3rd order finite difference scheme 13 !! tra_adv_qck_i : apply QUICK scheme in i-direction 14 !! tra_adv_qck_j : apply QUICK scheme in j-direction 15 15 !! tra_adv_cen2_k : 2nd centered scheme for the vertical advection 16 16 !!---------------------------------------------------------------------- 17 17 USE oce ! ocean dynamics and active tracers 18 18 USE dom_oce ! ocean space and time domain 19 USE trdmod_oce 20 USE trdtra ! ocean tracers trends19 USE trdmod_oce ! ocean space and time domain 20 USE trdtra ! ocean tracers trends 21 21 USE trabbl ! advective term in the BBL 22 22 USE lib_mpp ! distribued memory computing … … 32 32 PUBLIC tra_adv_qck ! routine called by step.F90 33 33 34 REAL(wp) :: r1_6 = 1./ 6.35 LOGICAL :: l_trd ! flag to compute trends34 LOGICAL :: l_trd ! flag to compute trends 35 REAL(wp) :: r1_6 = 1./ 6. ! 1/6 ratio 36 36 37 37 !! * Substitutions … … 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 !! $Id: traadv_qck.F90 2024 2010-07-29 10:57:35Z cetlod$42 !! $Id: $ 43 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- … … 83 83 !!---------------------------------------------------------------------- 84 84 !! 85 INTEGER , INTENT(in ):: kt ! ocean time-step index86 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)87 INTEGER , INTENT(in ):: kjpt ! number of tracers88 REAL(wp) , INTENT(in ), DIMENSION(jpk):: p2dt ! vertical profile of tracer time-step89 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk):: pun, pvn, pwn ! 3 ocean velocity components90 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt):: ptb, ptn ! before and now tracer fields91 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend92 !!---------------------------------------------------------------------- 93 94 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN85 INTEGER , INTENT(in ) :: kt ! ocean time-step index 86 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 87 INTEGER , INTENT(in ) :: kjpt ! number of tracers 88 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 89 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 91 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 92 !!---------------------------------------------------------------------- 93 94 IF( kt == nit000 ) THEN 95 95 IF(lwp) WRITE(numout,*) 96 96 IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype … … 103 103 104 104 ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 105 !---------------------------------------------------------------------------106 107 105 CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) 108 106 CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt ) 109 107 110 108 ! II. The vertical fluxes are computed with the 2nd order centered scheme 111 !-------------------------------------------------------------------------112 !113 109 CALL tra_adv_cen2_k( kt, cdtype, pwn, ptn, pta, kjpt ) 114 110 ! 115 111 END SUBROUTINE tra_adv_qck 116 112 113 117 114 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun, & 118 115 & ptb, ptn, pta, kjpt ) … … 122 119 USE oce , zwx => ua ! use ua as workspace 123 120 !! 124 INTEGER , INTENT(in ):: kt ! ocean time-step index125 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)126 INTEGER , INTENT(in ):: kjpt ! number of tracers127 REAL(wp) , INTENT(in ), DIMENSION(jpk):: p2dt ! vertical profile of tracer time-step128 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun ! zonal velocity component129 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! beforetracer fields130 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend121 INTEGER , INTENT(in ) :: kt ! ocean time-step index 122 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 123 INTEGER , INTENT(in ) :: kjpt ! number of tracers 124 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 125 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun ! i-velocity components 126 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 127 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 131 128 !! 132 129 INTEGER :: ji, jj, jk, jn ! dummy loop indices 133 REAL(wp) :: ztra, zbtr ! temporaryscalars134 REAL(wp) :: zdir, zdx, zdt, zmsk ! temporaryscalars135 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu, zfc, zfd 130 REAL(wp) :: ztra, zbtr ! local scalars 131 REAL(wp) :: zdir, zdx, zdt, zmsk ! local scalars 132 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu, zfc, zfd ! 3D wokspace 136 133 !---------------------------------------------------------------------- 137 134 138 135 ! ! =========== 139 136 DO jn = 1, kjpt ! tracer loop 140 137 ! ! =========== … … 154 151 END DO 155 152 END DO 156 ! 157 !--- Lateral boundary conditions 158 CALL lbc_lnk( zfc(:,:,:), 'T', 1. ) ; CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) 153 CALL lbc_lnk( zfc(:,:,:), 'T', 1. ) ; CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) ! Lateral boundary conditions 154 159 155 160 156 ! … … 182 178 END DO 183 179 END DO 184 END DO ! 185 180 END DO 186 181 !--- Lateral boundary conditions 187 CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) ;CALL lbc_lnk( zfd(:,:,:), 'T', 1. )188 CALL lbc_lnk( zfc(:,:,:), 'T', 1. ) ;CALL lbc_lnk( zwx(:,:,:), 'T', 1. )182 CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) ; CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) 183 CALL lbc_lnk( zfc(:,:,:), 'T', 1. ) ; CALL lbc_lnk( zwx(:,:,:), 'T', 1. ) 189 184 190 185 !--- QUICKEST scheme … … 199 194 END DO 200 195 END DO 201 !---Lateral boundary conditions202 CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) 196 CALL lbc_lnk( zfu(:,:,:), 'T', 1. ) ! Lateral boundary conditions 197 203 198 ! 204 199 ! Tracer flux on the x-direction … … 235 230 END SUBROUTINE tra_adv_qck_i 236 231 232 237 233 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn, & 238 234 & ptb, ptn, pta, kjpt ) … … 243 239 USE oce , zwy => ua ! use ua as workspace 244 240 !! 245 INTEGER , INTENT(in ):: kt ! ocean time-step index246 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)247 INTEGER , INTENT(in ):: kjpt ! number of tracers248 REAL(wp) , INTENT(in ), DIMENSION(jpk):: p2dt ! vertical profile of tracer time-step249 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pvn ! meridional velocity component250 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! beforetracer fields251 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend241 INTEGER , INTENT(in ) :: kt ! ocean time-step index 242 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 243 INTEGER , INTENT(in ) :: kjpt ! number of tracers 244 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 245 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pvn ! j-velocity components 246 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 247 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 252 248 !! 253 249 INTEGER :: ji, jj, jk, jn ! dummy loop indices 254 REAL(wp) :: ztra, zbtr ! temporaryscalars255 REAL(wp) :: zdir, zdx, zdt, zmsk ! temporaryscalars256 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu, zfc, zfd 250 REAL(wp) :: ztra, zbtr ! local scalars 251 REAL(wp) :: zdir, zdx, zdt, zmsk ! local scalars 252 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zfu, zfc, zfd ! 3D wokspace 257 253 !---------------------------------------------------------------------- 258 254 255 ! ! =========== 259 256 DO jn = 1, kjpt ! tracer loop 260 257 ! ! =========== … … 274 271 END DO 275 272 END DO 276 ! 277 !--- Lateral boundary conditions 278 CALL lbc_lnk( zfc(:,:,:), 'T', 1. ) ; CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) 273 CALL lbc_lnk( zfc(:,:,:), 'T', 1. ) ; CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) ! Lateral boundary conditions 274 279 275 280 276 ! … … 302 298 END DO 303 299 END DO 304 END DO !300 END DO 305 301 306 302 !--- Lateral boundary conditions … … 357 353 ! 358 354 END DO 359 355 ! 360 356 END SUBROUTINE tra_adv_qck_j 357 361 358 362 359 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn, & … … 365 362 !! 366 363 !!---------------------------------------------------------------------- 367 !!368 364 USE oce , zwz => ua ! use ua as workspace 369 365 !! 370 INTEGER , INTENT(in ):: kt ! ocean time-step index371 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)372 INTEGER , INTENT(in ):: kjpt ! number of tracers373 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pwn ! vertical velocity component374 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer field375 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend366 INTEGER , INTENT(in ) :: kt ! ocean time-step index 367 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 368 INTEGER , INTENT(in ) :: kjpt ! number of tracers 369 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pwn ! vertical velocity 370 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptn ! before and now tracer fields 371 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 376 372 !! 377 373 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 379 375 !!---------------------------------------------------------------------- 380 376 381 ! 377 ! ! =========== 382 378 DO jn = 1, kjpt ! tracer loop 383 379 ! ! =========== … … 424 420 !! ** Method : 425 421 !!---------------------------------------------------------------------- 426 REAL(wp), INTENT(in) , DIMENSION(jpi,jpj,jpk) ::pfu ! second upwind point427 REAL(wp), INTENT(in) , DIMENSION(jpi,jpj,jpk) ::pfd ! first douwning point428 REAL(wp), INTENT(in) , DIMENSION(jpi,jpj,jpk) ::pfc ! the central point (or the first upwind point)429 REAL(wp), INTENT(inout) , DIMENSION(jpi,jpj,jpk) ::puc ! input as Courant number ; output as flux422 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfu ! second upwind point 423 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfd ! first douwning point 424 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pfc ! the central point (or the first upwind point) 425 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: puc ! input as Courant number ; output as flux 430 426 !! 431 427 INTEGER :: ji, jj, jk ! dummy loop indices 432 REAL(wp) :: zcoef1, zcoef2, zcoef3 ! temporaryscalars433 REAL(wp) :: zc, zcurv, zfho ! 428 REAL(wp) :: zcoef1, zcoef2, zcoef3 ! local scalars 429 REAL(wp) :: zc, zcurv, zfho ! - - 434 430 !---------------------------------------------------------------------- 435 431 … … 460 456 ENDIF 461 457 puc(ji,jj,jk) = zfho 462 END DO463 END DO464 END DO458 END DO 459 END DO 460 END DO 465 461 ! 466 462 END SUBROUTINE quickest -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r2083 r2104 4 4 !! Ocean tracers: horizontal & vertical advective trend 5 5 !!============================================================================== 6 !! History : ! 95-12 (L. Mortier) Original code 7 !! ! 00-01 (H. Loukos) adapted to ORCA 8 !! ! 00-10 (MA Foujols E.Kestenare) include file not routine 9 !! ! 00-12 (E. Kestenare M. Levy) fix bug in trtrd indexes 10 !! ! 01-07 (E. Durand G. Madec) adaptation to ORCA config 11 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 12 !! 9.0 ! 04-01 (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 13 !! 9.0 ! 08-04 (S. Cravatte) add the i-, j- & k- trends computation 14 !! " " ! 09-11 (V. Garnier) Surface pressure gradient organization 15 !! 3.3 ! 10-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 16 !!---------------------------------------------------------------------- 17 6 !! History : OPA ! 1995-12 (L. Mortier) Original code 7 !! ! 2000-01 (H. Loukos) adapted to ORCA 8 !! ! 2000-10 (MA Foujols E.Kestenare) include file not routine 9 !! ! 2000-12 (E. Kestenare M. Levy) fix bug in trtrd indexes 10 !! ! 2001-07 (E. Durand G. Madec) adaptation to ORCA config 11 !! 8.5 ! 2002-06 (G. Madec) F90: Free form and module 12 !! NEMO 1.0 ! 2004-01 (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 13 !! 2.0 ! 2008-04 (S. Cravatte) add the i-, j- & k- trends computation 14 !! - ! 2009-11 (V. Garnier) Surface pressure gradient organization 15 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 16 !!---------------------------------------------------------------------- 18 17 19 18 !!---------------------------------------------------------------------- … … 53 52 CONTAINS 54 53 55 SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, &54 SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, & 56 55 & ptb, ptn, pta, kjpt ) 57 56 !!---------------------------------------------------------------------- … … 71 70 USE oce , zwy => va ! use va as workspace 72 71 !! 73 INTEGER , INTENT(in ) :: kt ! ocean time-step index 74 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 77 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 78 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 79 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 80 !! 81 INTEGER :: ji, jj, jk, jn ! dummy loop indices 82 REAL(wp) :: & 83 z2dtt, zbtr, ztra, & ! temporary scalar 84 zfp_ui, zfp_vj, zfp_wk, & ! " " 85 zfm_ui, zfm_vj, zfm_wk ! " " 86 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zwi, zwz ! temporary workspace 87 REAL(wp), DIMENSION (:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz 88 !!---------------------------------------------------------------------- 89 90 91 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 72 INTEGER , INTENT(in ) :: kt ! ocean time-step index 73 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 74 INTEGER , INTENT(in ) :: kjpt ! number of tracers 75 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 76 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 77 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 79 !! 80 INTEGER :: ji, jj, jk, jn ! dummy loop indices 81 REAL(wp) :: z2dtt, zbtr, ztra ! local scalar 82 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk ! - - 83 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk ! - - 84 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zwi, zwz ! 3D workspace 85 REAL(wp), DIMENSION (:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz 86 !!---------------------------------------------------------------------- 87 88 IF( kt == nit000 ) THEN 92 89 WRITE(numout,*) 93 90 WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype … … 99 96 ! 100 97 IF( l_trd ) THEN 101 ALLOCATE( ztrdx(jpi,jpj,jpk) ) ; ztrdx(:,:,:) = 0. 102 ALLOCATE( ztrdy(jpi,jpj,jpk) ) ; ztrdy(:,:,:) = 0. 103 ALLOCATE( ztrdz(jpi,jpj,jpk) ) ; ztrdz(:,:,:) = 0. 98 ALLOCATE( ztrdx(jpi,jpj,jpk) ) ; ztrdx(:,:,:) = 0.e0 99 ALLOCATE( ztrdy(jpi,jpj,jpk) ) ; ztrdy(:,:,:) = 0.e0 100 ALLOCATE( ztrdz(jpi,jpj,jpk) ) ; ztrdz(:,:,:) = 0.e0 104 101 END IF 105 102 ! … … 190 187 191 188 ! antidiffusive flux on k 192 ! Surface value 193 zwz(:,:,1) = 0.e0 194 ! Interior value 195 DO jk = 2, jpkm1 189 zwz(:,:,1) = 0.e0 ! Surface value 190 ! 191 DO jk = 2, jpkm1 ! Interior value 196 192 DO jj = 1, jpj 197 193 DO ji = 1, jpi … … 200 196 END DO 201 197 END DO 202 203 ! Lateral bondary conditions 204 CALL lbc_lnk( zwx, 'U', -1. ) 205 CALL lbc_lnk( zwy, 'V', -1. ) 198 CALL lbc_lnk( zwx, 'U', -1. ) ; CALL lbc_lnk( zwy, 'V', -1. ) ! Lateral bondary conditions 206 199 CALL lbc_lnk( zwz, 'W', 1. ) 207 200 … … 265 258 !! in-space based differencing for fluid 266 259 !!---------------------------------------------------------------------- 267 REAL(wp), DIMENSION(jpk) , INTENT( in ) :: & 268 p2dt ! vertical profile of tracer time-step 269 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( in ) :: & 270 pbef, & ! before field 271 paft ! after field 272 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( inout ) :: & 273 paa, & ! monotonic flux in the i direction 274 pbb, & ! monotonic flux in the j direction 275 pcc ! monotonic flux in the k direction 260 REAL(wp), DIMENSION(jpk) , INTENT(in ) :: p2dt ! vertical profile of tracer time-step 261 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field 262 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 276 263 !! 277 264 INTEGER :: ji, jj, jk ! dummy loop indices … … 332 319 END DO 333 320 END DO 334 335 ! lateral boundary condition on zbetup & zbetdo (unchanged sign) 336 CALL lbc_lnk( zbetup, 'T', 1. ) 337 CALL lbc_lnk( zbetdo, 'T', 1. ) 321 CALL lbc_lnk( zbetup, 'T', 1. ) ; CALL lbc_lnk( zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 322 338 323 339 324 … … 362 347 END DO 363 348 END DO 364 365 ! lateral boundary condition on paa, pbb, pcc 366 CALL lbc_lnk( paa, 'U', -1. ) ! changed sign 367 CALL lbc_lnk( pbb, 'V', -1. ) ! changed sign 349 CALL lbc_lnk( paa, 'U', -1. ) ; CALL lbc_lnk( pbb, 'V', -1. ) ! lateral boundary condition (changed sign) 368 350 ! 369 351 END SUBROUTINE nonosc -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r2083 r2104 5 5 !!============================================================================== 6 6 !! History : 1.0 ! 2006-08 (L. Debreu, R. Benshila) Original code 7 !!3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport7 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 8 8 !!---------------------------------------------------------------------- 9 9 … … 41 41 CONTAINS 42 42 43 SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, &43 SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, & 44 44 & ptb, ptn, pta, kjpt ) 45 45 !!---------------------------------------------------------------------- … … 74 74 !! Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 75 75 !!---------------------------------------------------------------------- 76 !!* Module used77 76 USE oce , zwx => ua ! use ua as workspace 78 77 USE oce , zwy => va ! use va as workspace 79 !! * Arguments80 INTEGER , INTENT(in ):: kt ! ocean time-step index81 CHARACTER(len=3) , INTENT(in ):: cdtype ! =TRA or TRC (tracer indicator)82 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components83 INTEGER , INTENT(in ) :: kjpt ! number of tracers84 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step85 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt):: ptb, ptn ! before and now tracer fields86 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend87 !! * Local declarations78 !! 79 INTEGER , INTENT(in ) :: kt ! ocean time-step index 80 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 81 INTEGER , INTENT(in ) :: kjpt ! number of tracers 82 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 83 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 86 !! 88 87 INTEGER :: ji, jj, jk, jn ! dummy loop indices 89 REAL(wp) :: ztra, zbtr, zcoef ! temporary scalars 90 REAL(wp) :: zfp_ui, zfm_ui, zcenut ! " " 91 REAL(wp) :: zfp_vj, zfm_vj, zcenvt ! " " ! " " 92 REAL(wp) :: z2dtt 93 REAL(wp) :: ztak, zfp_wk, zfm_wk ! " " 94 REAL(wp) :: zeeu, zeev, z_hdivn 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu , zltv ! " " 96 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zti, ztw ! " " 97 !!---------------------------------------------------------------------- 98 99 100 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 88 REAL(wp) :: ztra, zbtr, zcoef ! local scalars 89 REAL(wp) :: zfp_ui, zfm_ui, zcenut ! - - 90 REAL(wp) :: zfp_vj, zfm_vj, zcenvt ! - - 91 REAL(wp) :: z2dtt ! - - 92 REAL(wp) :: ztak, zfp_wk, zfm_wk ! - - 93 REAL(wp) :: zeeu, zeev, z_hdivn ! - - 94 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zltu , zltv ! 3D workspace 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zti, ztw ! - - 96 !!---------------------------------------------------------------------- 97 98 IF( kt == nit000 ) THEN 101 99 IF(lwp) WRITE(numout,*) 102 100 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype … … 113 111 ! ---------------------------------- 114 112 zltu(:,:,jpk) = 0.e0 ; zltv(:,:,jpk) = 0.e0 115 ! ! ===============113 ! 116 114 DO jk = 1, jpkm1 ! Horizontal slab 117 ! ! ===============115 ! 118 116 ! Laplacian 119 ! First derivative (gradient) 120 DO jj = 1, jpjm1 117 DO jj = 1, jpjm1 ! First derivative (gradient) 121 118 DO ji = 1, fs_jpim1 ! vector opt. 122 119 zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) … … 126 123 END DO 127 124 END DO 128 ! Second derivative (divergence) 129 DO jj = 2, jpjm1 125 DO jj = 2, jpjm1 ! Second derivative (divergence) 130 126 DO ji = fs_2, fs_jpim1 ! vector opt. 131 127 zcoef = 1. / ( 6. * fse3t(ji,jj,jk) ) … … 134 130 END DO 135 131 END DO 136 ! ! ================= 137 END DO ! End of slab 138 ! ! ================= 139 140 ! Lateral boundary conditions on the laplacian (zlt) (unchanged sgn) 141 CALL lbc_lnk( zltu, 'T', 1. ) ; CALL lbc_lnk( zltv, 'T', 1. ) 132 ! 133 END DO ! End of slab 134 CALL lbc_lnk( zltu, 'T', 1. ) ; CALL lbc_lnk( zltv, 'T', 1. ) ! Lateral boundary cond. (unchanged sgn) 142 135 143 136 ! 144 137 ! Horizontal advective fluxes 145 DO jk = 1, jpkm1 138 DO jk = 1, jpkm1 ! Horizontal slab 146 139 DO jj = 1, jpjm1 147 140 DO ji = 1, fs_jpim1 ! vector opt. … … 159 152 END DO 160 153 END DO 161 END DO154 END DO ! End of slab 162 155 163 156 zltu(:,:,:) = pta(:,:,:,jn) ! store pta trends … … 176 169 END DO 177 170 END DO 178 ! ! ===============171 ! 179 172 END DO ! End of slab 180 ! ! ===============181 173 182 174 ! Horizontal trend used in tra_adv_ztvd subroutine … … 286 278 END SUBROUTINE tra_adv_ubs 287 279 280 288 281 SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt ) 289 282 !!--------------------------------------------------------------------- … … 299 292 !! in-space based differencing for fluid 300 293 !!---------------------------------------------------------------------- 301 REAL(wp), INTENT(in ), DIMENSION(jpk) :: p2dt 294 REAL(wp), INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 302 295 REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field 303 296 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: paft ! after field -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbc.F90
r2024 r2104 194 194 WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt 195 195 END SUBROUTINE tra_bbc 196 SUBROUTINE tra_bbc_init ! Empty routine 197 END SUBROUTINE tra_bbc_init 196 198 #endif 197 199 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90
r2082 r2104 26 26 USE phycst ! 27 27 USE eosbn2 ! equation of state 28 USE trdmod_oce 29 USE trdtra ! ocean active tracers trends28 USE trdmod_oce ! ocean space and time domain 29 USE trdtra ! ocean active tracers trends 30 30 USE iom ! IOM server 31 31 USE in_out_manager ! I/O manager 32 32 USE lbclnk ! ocean lateral boundary conditions 33 33 USE prtctl ! Print control 34 USE trc_oce 34 USE trc_oce ! share passive tracers/Ocean variables 35 35 36 36 IMPLICIT NONE … … 49 49 # endif 50 50 51 LOGICAL, PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 52 51 53 ! !!* Namelist nambbl * 52 54 INTEGER , PUBLIC :: nn_bbl_ldf = 0 !: =1 : diffusive bbl or not (=0) … … 57 59 REAL(wp), PUBLIC :: rn_gambbl = 10.e0 !: lateral coeff. for bottom boundary layer scheme [s] 58 60 61 REAL(wp), DIMENSION(jpi,jpj), PUBLIC :: utr_bbl, vtr_bbl ! u- (v-) transport in the bottom boundary layer 62 59 63 INTEGER , DIMENSION(jpi,jpj) :: mbkt ! vertical index of the bottom ocean T-level 60 64 INTEGER , DIMENSION(jpi,jpj) :: mbku , mbkv ! vertical index of the (upper) bottom ocean U/V-level 61 65 INTEGER , DIMENSION(jpi,jpj) :: mbku_d , mbkv_d ! vertical index of the "lower" bottom ocean U/V-level 62 66 INTEGER , DIMENSION(jpi,jpj) :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction 63 REAL(wp), DIMENSION(jpi,jpj), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer64 67 REAL(wp), DIMENSION(jpi,jpj) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 65 68 REAL(wp), DIMENSION(jpi,jpj) :: ahu_bbl , ahv_bbl ! masked diffusive bbl coefficients at u and v-points 66 69 REAL(wp), DIMENSION(jpi,jpj) :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points 67 REAL(wp), DIMENSION(jpi,jpj) :: e1e2t_r ! thichness of the bbl (e3) at u and v-points 68 LOGICAL, PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 70 REAL(wp), DIMENSION(jpi,jpj) :: e1e2t_r ! thichness of the bbl (e3) at u and v-points 69 71 70 72 !! * Substitutions … … 73 75 !!---------------------------------------------------------------------- 74 76 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 75 !! $Id$ 77 !! $Id$ 76 78 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 77 79 !!---------------------------------------------------------------------- 78 80 79 81 CONTAINS 80 81 82 82 83 SUBROUTINE tra_bbl( kt ) … … 90 91 !!---------------------------------------------------------------------- 91 92 INTEGER, INTENT( in ) :: kt ! ocean time-step 92 ! 93 !! 93 94 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 94 95 !!---------------------------------------------------------------------- … … 154 155 !! convection is satified) 155 156 !! 156 !!157 157 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 158 158 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 159 159 !!---------------------------------------------------------------------- 160 !!* Arguments 161 INTEGER , INTENT(in ) :: kjpt ! number of tracers 162 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptrab ! before and now tracer fields 163 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptraa ! tracer trend 160 INTEGER , INTENT(in ) :: kjpt ! number of tracers 161 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptrab ! before and now tracer fields 162 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptraa ! tracer trend 163 !! 164 INTEGER :: ji, jj, jn ! dummy loop indices 165 INTEGER :: ik ! local integer 166 REAL(wp) :: zbtr, ztra ! local scalars 167 REAL(wp), DIMENSION(jpi,jpj) :: ztrb, zkx, zky ! 2D workspace 168 !!---------------------------------------------------------------------- 164 169 ! 165 INTEGER :: ji, jj, jn ! dummy loop indices 166 INTEGER :: ik ! temporary integers 167 REAL(wp) :: zbtr, ztra ! temporary 168 REAL(wp), DIMENSION(jpi,jpj) :: ztrb, zkx, zky ! 2D workspace 169 !!---------------------------------------------------------------------- 170 ! =========== 170 ! ! =========== 171 171 DO jn = 1, kjpt ! tracer loop 172 172 ! ! =========== … … 183 183 END DO 184 184 ! 185 !!gm forced unrolling should be uuseless in the loop below (no indirect adressing) 185 186 # if defined key_vectopt_loop 186 187 DO jj = 1, 1 ! vector opt. (forced unrolling) … … 212 213 ! 213 214 END SUBROUTINE tra_bbl_dif 215 214 216 215 217 SUBROUTINE tra_bbl_adv( ptrab, ptraa, kjpt ) … … 233 235 !! 234 236 !!---------------------------------------------------------------------- 235 !!* Arguments 236 INTEGER , INTENT(in ) :: kjpt ! number of tracers 237 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptrab ! before and now tracer fields 238 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptraa ! tracer trend 239 ! 237 INTEGER , INTENT(in ) :: kjpt ! number of tracers 238 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptrab ! before and now tracer fields 239 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: ptraa ! tracer trend 240 !! 240 241 INTEGER :: ji, jj, jk, jn ! dummy loop indices 241 INTEGER :: ik ! temporaryintegers242 INTEGER :: iis , iid , ijs , ijd ! --243 INTEGER :: ikus, ikud, ikvs, ikvd ! --244 REAL(wp) :: zbtr, ztra ! - -245 REAL(wp) :: zu_bbl, zv_bbl ! --242 INTEGER :: ik ! local integers 243 INTEGER :: iis , iid , ijs , ijd ! - - 244 INTEGER :: ikus, ikud, ikvs, ikvd ! - - 245 REAL(wp) :: zbtr, ztra ! local scalars 246 REAL(wp) :: zu_bbl, zv_bbl ! - - 246 247 !!---------------------------------------------------------------------- 247 248 … … 277 278 ptraa(iid,jj,ikud,jn) = ptraa(iid,jj,ikud,jn) + ztra 278 279 ENDIF 280 ! 279 281 IF( vtr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero j-direction bbl advection 280 282 ! down-slope j/k-indices (deep) & up-slope j/k indices (shelf) … … 306 308 END SUBROUTINE tra_bbl_adv 307 309 310 308 311 SUBROUTINE bbl( kt, cdtype ) 309 312 !!---------------------------------------------------------------------- … … 330 333 !! local density (i.e. referenced at a common local depth). 331 334 !! 332 !!333 335 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 334 336 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 335 337 !!---------------------------------------------------------------------- 336 INTEGER , INTENT(in ) :: kt ! ocean time-step index 337 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 338 INTEGER , INTENT(in ) :: kt ! ocean time-step index 339 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 340 !! 338 341 INTEGER :: ji, jj ! dummy loop indices 339 INTEGER :: ik ! temporaryintegers340 INTEGER :: iis , iid , ijs , ijd ! --341 INTEGER :: ikus, ikud, ikvs, ikvd ! --342 REAL(wp) :: zsign, zsigna, zgbbl ! temporaryscalars343 REAL(wp) :: zgdrho, zt, zs, zh ! --344 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, ztb, zsb, zdep ! - -342 INTEGER :: ik ! local integers 343 INTEGER :: iis , iid , ijs , ijd ! - - 344 INTEGER :: ikus, ikud, ikvs, ikvd ! - - 345 REAL(wp) :: zsign, zsigna, zgbbl ! local scalars 346 REAL(wp) :: zgdrho, zt, zs, zh ! - - 347 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, ztb, zsb, zdep ! 2D workspace 345 348 !! 346 349 REAL(wp) :: fsalbt, fsbeta, pft, pfs, pfh ! statement function … … 377 380 !!---------------------------------------------------------------------- 378 381 382 IF( kt == nit000 ) THEN 383 IF(lwp) WRITE(numout,*) 384 IF(lwp) WRITE(numout,*) 'trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 385 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 386 ENDIF 387 379 388 ! !* bottom temperature, salinity, velocity and depth 380 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN381 IF(lwp) WRITE(numout,*) ' '382 IF(lwp) WRITE(numout,*) ' trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype383 IF(lwp) WRITE(numout,*) ' '384 ENDIF385 386 389 #if defined key_vectopt_loop 387 390 DO jj = 1, 1 ! vector opt. (forced unrolling) … … 392 395 #endif 393 396 ik = mbkt(ji,jj) ! bottom T-level index 394 ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) 397 ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) ! bottom before T and S 395 398 zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) 396 399 zdep(ji,jj) = fsdept_0(ji,jj,ik) ! bottom T-level reference depth … … 440 443 ENDIF 441 444 442 443 445 ! !-------------------! 444 446 IF( nn_bbl_adv /= 0 ) THEN ! advective bbl ! … … 477 479 END DO 478 480 END DO 479 !481 ! 480 482 CASE( 2 ) != bbl velocity = F( delta rho ) 481 483 zgbbl = grav * rn_gambbl … … 531 533 !! 532 534 !! ** Method : Read the nambbl namelist and check the parameters 533 !! called by tra_bbl at the first timestep (nit000)535 !! called by tra_bbl at the first timestep (nit000) 534 536 !!---------------------------------------------------------------------- 535 537 INTEGER :: ji, jj ! dummy loop indices 536 538 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integer 537 539 REAL(wp), DIMENSION(jpi,jpj) :: zmbk ! 2D workspace 538 540 !! 539 541 NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 540 542 !!---------------------------------------------------------------------- … … 634 636 LOGICAL, PUBLIC, PARAMETER :: lk_trabbl = .FALSE. !: bbl flag 635 637 CONTAINS 636 SUBROUTINE tra_bbl( kt ) ! Empty routine 638 SUBROUTINE tra_bbl_init ! Dummy routine 639 END SUBROUTINE tra_bbl_init 640 SUBROUTINE tra_bbl( kt ) ! Dummy routine 637 641 WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt 638 642 END SUBROUTINE tra_bbl -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tradmp.F90
r2024 r2104 726 726 WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt 727 727 END SUBROUTINE tra_dmp 728 SUBROUTINE tra_dmp_init ! Empty routine 729 END SUBROUTINE tra_dmp_init 728 730 #endif 729 731 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf.F90
r2082 r2104 9 9 10 10 !!---------------------------------------------------------------------- 11 !! tra_ldf : update the tracer trend with the lateral diffusion12 !! ldf_ctl: initialization, namelist read, and parameters control13 !! ldf_ano : compute lateral diffusion for constant T-S profiles11 !! tra_ldf : update the tracer trend with the lateral diffusion 12 !! tra_ldf_init : initialization, namelist read, and parameters control 13 !! ldf_ano : compute lateral diffusion for constant T-S profiles 14 14 !!---------------------------------------------------------------------- 15 15 USE oce ! ocean dynamics and tracers … … 37 37 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 38 38 #if defined key_traldf_ano 39 REAL, DIMENSION(jpi,jpj,jpk) :: t0_ldf, s0_ldf ! lateral diffusion trends of T & S 40 ! ! for a constant vertical profile 39 REAL, DIMENSION(jpi,jpj,jpk) :: t0_ldf, s0_ldf ! lateral diffusion trends of T & S for a constant profile 41 40 #endif 42 41 … … 73 72 CASE ( 1 ) ; CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! rotated laplacian 74 73 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 75 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. horizontal bilap lacian74 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. horizontal bilap. 76 75 ! 77 76 CASE ( -1 ) ! esopa: test all possibility with control print -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r2082 r2104 4 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 5 5 !!============================================================================== 6 !! History : !91-11 (G. Madec) Original code7 !! !93-03 (M. Guyon) symetrical conditions8 !! !95-11 (G. Madec) suppress volumetric scale factors9 !! !96-01 (G. Madec) statement function for e310 !! !96-01 (M. Imbard) mpp exchange11 !! !97-07 (G. Madec) optimization, and ahtt12 !! 8.5 !02-08 (G. Madec) F90: Free form and module13 !! 9.0 !04-08 (C. Talandier) New trends organization14 !! !05-11 (G. Madec) zps or sco as default option15 !! 3.3 !10-05 (C. Ethe, G. Madec) merge TRC-TRA6 !! History : OPA ! 1991-11 (G. Madec) Original code 7 !! ! 1993-03 (M. Guyon) symetrical conditions 8 !! ! 1995-11 (G. Madec) suppress volumetric scale factors 9 !! ! 1996-01 (G. Madec) statement function for e3 10 !! ! 1996-01 (M. Imbard) mpp exchange 11 !! ! 1997-07 (G. Madec) optimization, and ahtt 12 !! 8.5 ! 2002-08 (G. Madec) F90: Free form and module 13 !! NEMO 1.0 ! 2004-08 (C. Talandier) New trends organization 14 !! - ! 2005-11 (G. Madec) zps or sco as default option 15 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 16 16 !!============================================================================== 17 17 … … 20 20 !! using a iso-level biharmonic operator 21 21 !!---------------------------------------------------------------------- 22 !! * Modules used23 22 USE oce ! ocean dynamics and active tracers 24 23 USE dom_oce ! ocean space and time domain … … 33 32 PRIVATE 34 33 35 !! * Routine accessibility 36 PUBLIC tra_ldf_bilap ! routine called by step.F90 34 PUBLIC tra_ldf_bilap ! routine called by step.F90 37 35 38 36 !! * Substitutions … … 43 41 !!---------------------------------------------------------------------- 44 42 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 45 !! $Id$ 46 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt43 !! $Id$ 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 47 45 !!---------------------------------------------------------------------- 48 46 … … 80 78 USE oce , ztv => va ! use va as workspace 81 79 !! 82 INTEGER , INTENT(in ) :: kt! ocean time-step index83 CHARACTER(len=3) , INTENT(in ) :: cdtype! =TRA or TRC (tracer indicator)84 INTEGER , INTENT(in ) :: kjpt! number of tracers85 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pgu, pgv! tracer gradient at pstep levels86 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb! before and now tracer fields87 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend80 INTEGER , INTENT(in ) :: kt ! ocean time-step index 81 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 82 INTEGER , INTENT(in ) :: kjpt ! number of tracers 83 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 88 86 !! 89 INTEGER :: ji, jj, jk, jn ! dummy loop indices 90 INTEGER :: iku, ikv ! temporary integers 91 REAL(wp) :: zbtr, ztra ! temporary scalars 92 REAL(wp), DIMENSION(jpi,jpj) :: & 93 zeeu, zeev, zlt ! 2D workspace 87 INTEGER :: ji, jj, jk, jn ! dummy loop indices 88 INTEGER :: iku, ikv ! local integers 89 REAL(wp) :: zbtr, ztra ! local scalars 90 REAL(wp), DIMENSION(jpi,jpj) :: zeeu, zeev, zlt ! 2D workspace 94 91 !!---------------------------------------------------------------------- 95 92 96 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN93 IF( kt == nit000 ) THEN 97 94 IF(lwp) WRITE(numout,*) 98 95 IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype … … 103 100 ! ! =========== 104 101 ! 105 DO jk = 1, jpkm1 102 DO jk = 1, jpkm1 ! Horizontal slab 106 103 ! 107 108 ! 0. Initialization of metric arrays (for z- or s-coordinates) 109 ! ---------------------------------- 104 ! !== Initialization of metric arrays (for z- or s-coordinates) ==! 110 105 DO jj = 1, jpjm1 111 106 DO ji = 1, fs_jpim1 ! vector opt. … … 115 110 END DO 116 111 117 118 ! 1. Laplacian 119 ! ------------ 120 121 ! First derivative (gradient) 122 DO jj = 1, jpjm1 112 ! !== Laplacian ==! 113 ! 114 DO jj = 1, jpjm1 ! First derivative (gradient) 123 115 DO ji = 1, fs_jpim1 ! vector opt. 124 116 ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) … … 126 118 END DO 127 119 END DO 128 IF( ln_zps ) THEN ! set gradient at partial step level120 IF( ln_zps ) THEN ! set gradient at partial step level 129 121 DO jj = 1, jpjm1 130 122 DO ji = 1, jpim1 … … 137 129 END DO 138 130 ENDIF 139 140 ! Second derivative (divergence) multiply by the eddy diffusivity coefficient 141 DO jj = 2, jpjm1 131 DO jj = 2, jpjm1 ! Second derivative (divergence) time the eddy diffusivity coefficient 142 132 DO ji = fs_2, fs_jpim1 ! vector opt. 143 133 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 144 zlt(ji,jj) = fsahtt(ji,jj,jk) &145 & * zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk))134 zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 135 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 146 136 END DO 147 137 END DO 138 CALL lbc_lnk( zlt, 'T', 1. ) ! Lateral boundary conditions (unchanged sgn) 148 139 149 ! Lateral boundary conditions on the laplacian (zlt) (unchanged sgn) 150 CALL lbc_lnk( zlt, 'T', 1. ) 151 152 ! 2. Bilaplacian 153 ! -------------- 154 155 ! third derivative (gradient) 156 DO jj = 1, jpjm1 140 ! !== Bilaplacian ==! 141 ! 142 DO jj = 1, jpjm1 ! third derivative (gradient) 157 143 DO ji = 1, fs_jpim1 ! vector opt. 158 144 ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj ) - zlt(ji,jj) ) … … 160 146 END DO 161 147 END DO 162 163 ! fourth derivative (divergence) and add to the general tracer trend 164 DO jj = 2, jpjm1 148 DO jj = 2, jpjm1 ! fourth derivative (divergence) and add to the general tracer trend 165 149 DO ji = fs_2, fs_jpim1 ! vector opt. 166 150 ! horizontal diffusive trends … … 171 155 END DO 172 156 END DO 173 ! ! ===============157 ! 174 158 END DO ! Horizontal slab 175 ! ! ===============159 ! 176 160 ! "zonal" mean lateral diffusive heat and salt transport 177 161 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN … … 179 163 IF( jn == jp_sal ) pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 180 164 ENDIF 181 ! 182 END DO 183 165 ! ! =========== 166 END DO ! tracer loop 167 ! ! =========== 184 168 END SUBROUTINE tra_ldf_bilap 185 169 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r2082 r2104 16 16 !! ldfght : ??? 17 17 !!---------------------------------------------------------------------- 18 !! * Modules used19 18 USE oce ! ocean dynamics and tracers variables 20 19 USE dom_oce ! ocean space and time domain variables … … 29 28 PRIVATE 30 29 31 !! * Routine accessibility 32 PUBLIC tra_ldf_bilapg ! routine called by step.F90 30 PUBLIC tra_ldf_bilapg ! routine called by step.F90 33 31 34 32 !! * Substitutions … … 38 36 !!---------------------------------------------------------------------- 39 37 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 40 !! $Id$ 38 !! $Id$ 41 39 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 42 40 !!---------------------------------------------------------------------- … … 68 66 !! biharmonic mixing trend. 69 67 !!---------------------------------------------------------------------- 70 !!* Arguments71 68 INTEGER , INTENT(in ) :: kt ! ocean time-step index 72 69 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 73 70 INTEGER , INTENT(in ) :: kjpt ! number of tracers 74 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt):: ptb ! before and now tracer fields75 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt):: pta ! tracer trend76 !! * Local declarations71 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 72 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 73 !! 77 74 INTEGER :: ji, jj, jk, jn ! dummy loop indices 78 REAL(wp), DIMENSION(jpi,jpj,jpk,SIZE(ptb,4)) :: & 79 wk1, wk2 ! work array used for rotated biharmonic 80 ! ! operator on tracers and/or momentum 81 !!---------------------------------------------------------------------- 82 83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 75 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt) :: wk1, wk2 ! 4D workspace 76 !!---------------------------------------------------------------------- 77 78 IF( kt == nit000 ) THEN 84 79 IF(lwp) WRITE(numout,*) 85 80 IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype … … 91 86 ! 1. Laplacian of ptb * aht 92 87 ! ----------------------------- 93 ! rotated harmonic operator applied to ptb and multiply by aht ; output in wk1 94 95 CALL ldfght( kt, cdtype, ptb, wk1, kjpt, 1 ) 96 88 CALL ldfght( kt, cdtype, ptb, wk1, kjpt, 1 ) ! rotated harmonic operator applied to ptb and multiply by aht 89 ! ! output in wk1 97 90 ! 98 91 DO jn = 1, kjpt 99 ! Lateral boundary conditions on wk1 (unchanged sign) 100 CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. ) 92 CALL lbc_lnk( wk1(:,:,:,jn) , 'T', 1. ) ! Lateral boundary conditions on wk1 (unchanged sign) 101 93 END DO 102 94 103 95 ! 2. Bilaplacian of ptb 104 96 ! ------------------------- 105 ! rotated harmonic operator applied to wk1 ; output in wk2 106 107 CALL ldfght( kt, cdtype, wk1, wk2, kjpt, 2 ) 97 CALL ldfght( kt, cdtype, wk1, wk2, kjpt, 2 ) ! rotated harmonic operator applied to wk1 ; output in wk2 108 98 109 99 … … 167 157 !! 168 158 !!---------------------------------------------------------------------- 169 !!170 159 USE oce , zftv => ua ! use ua as workspace 171 160 !! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_iso.F90
r2082 r2104 4 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 5 5 !!====================================================================== 6 !! History : 7 !! 8 !! 9 !! 10 !! 3.0 ! 2008-01(C. Ethe, G. Madec) Merge TRA-TRC6 !! History : OPA ! 1994-08 (G. Madec, M. Imbard) 7 !! 8.0 ! 1997-05 (G. Madec) split into traldf and trazdf 8 !! NEMO ! 2002-08 (G. Madec) Free form, F90 9 !! 1.0 ! 2005-11 (G. Madec) merge traldf and trazdf :-) 10 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 11 11 !!---------------------------------------------------------------------- 12 12 #if defined key_ldfslp || defined key_esopa 13 13 !!---------------------------------------------------------------------- 14 14 !! 'key_ldfslp' slope of the lateral diffusive direction 15 !!----------------------------------------------------------------------16 15 !!---------------------------------------------------------------------- 17 16 !! tra_ldf_iso : update the tracer trend with the horizontal … … 45 44 !!---------------------------------------------------------------------- 46 45 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 47 !! $Id$ 46 !! $Id$ 48 47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 48 !!---------------------------------------------------------------------- … … 92 91 !! ** Action : Update pta arrays with the before rotated diffusion 93 92 !!---------------------------------------------------------------------- 94 !!* Module used95 93 USE oce , zftu => ua ! use ua as workspace 96 94 USE oce , zftv => va ! use va as workspace 97 !! * Arguments98 INTEGER , INTENT(in ) :: kt! ocean time-step index99 CHARACTER(len=3) , INTENT(in ) :: cdtype! =TRA or TRC (tracer indicator)100 INTEGER , INTENT(in ) :: kjpt! number of tracers101 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pgu, pgv! tracer gradient at pstep levels102 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb! before and now tracer fields103 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend104 REAL(wp) , INTENT(in ) :: pahtb0! background diffusion coef105 !! * Local declarations95 !! 96 INTEGER , INTENT(in ) :: kt ! ocean time-step index 97 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 98 INTEGER , INTENT(in ) :: kjpt ! number of tracers 99 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 100 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 101 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 102 REAL(wp) , INTENT(in ) :: pahtb0 ! background diffusion coef 103 !! 106 104 INTEGER :: ji, jj, jk,jn ! dummy loop indices 107 INTEGER :: iku, ikv ! temporary integer108 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! temporaryscalars109 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! " "110 REAL(wp) :: zcoef0, zbtr, ztra ! " "105 INTEGER :: iku, ikv ! temporary integer 106 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 107 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 108 REAL(wp) :: zcoef0, zbtr, ztra ! - - 111 109 REAL(wp), DIMENSION(jpi,jpj) :: zdkt, zdk1t ! 2D workspace 112 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, ztfw 110 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, ztfw ! 3D workspace 113 111 #if defined key_diaar5 114 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! " "115 REAL(wp) :: zztmp ! " "112 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 113 REAL(wp) :: zztmp ! local scalar 116 114 #endif 117 115 !!---------------------------------------------------------------------- 118 116 119 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN117 IF( kt == nit000 ) THEN 120 118 IF(lwp) WRITE(numout,*) 121 119 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype … … 159 157 !! II - horizontal trend (full) 160 158 !!---------------------------------------------------------------------- 161 162 159 !CDIR PARALLEL DO PRIVATE( zdk1t ) 163 160 ! ! =============== … … 167 164 ! ------------------------------------------------ 168 165 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 169 170 166 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 171 172 IF( jk == 1 ) THEN 173 zdkt(:,:) = zdk1t(:,:) 174 ELSE 175 zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 167 ! 168 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) 169 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 176 170 ENDIF 177 171 178 179 172 ! 2. Horizontal fluxes 180 ! -------------------- 181 173 ! -------------------- 182 174 DO jj = 1 , jpjm1 183 175 DO ji = 1, fs_jpim1 ! vector opt. 184 176 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) 185 177 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) 186 178 ! 187 179 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & 188 180 & + tmask(ji+1,jj,jk+1) + tmask(ji,jj,jk ), 1. ) 189 181 ! 190 182 zmskv = 1. / MAX( tmask(ji,jj+1,jk ) + tmask(ji,jj,jk+1) & 191 183 & + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk ), 1. ) 192 184 ! 193 185 zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 194 186 zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv … … 202 194 END DO 203 195 END DO 204 205 196 206 197 ! II.4 Second derivative (divergence) and add to the general trend … … 216 207 END DO ! End of slab 217 208 ! ! =============== 218 ! "Poleward" diffusive heat or salt transports 209 ! 210 ! "Poleward" diffusive heat or salt transports (T-S case only) 219 211 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 220 212 IF( jn == jp_tem) pht_ldf(:) = ptr_vj( zftv(:,:,:) ) … … 229 221 DO jj = 2, jpjm1 230 222 DO ji = fs_2, fs_jpim1 ! vector opt. 231 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk) &232 &* ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) * e1u(ji,jj) * fse3u(ji,jj,jk)223 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk) & 224 & * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) * e1u(ji,jj) * fse3u(ji,jj,jk) 233 225 END DO 234 226 END DO … … 240 232 DO jj = 2, jpjm1 241 233 DO ji = fs_2, fs_jpim1 ! vector opt. 242 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk) &243 &* ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) * e2v(ji,jj) * fse3v(ji,jj,jk)234 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk) & 235 & * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) * e2v(ji,jj) * fse3v(ji,jj,jk) 244 236 END DO 245 237 END DO … … 269 261 DO ji = fs_2, fs_jpim1 ! vector opt. 270 262 zcoef0 = - fsahtw(ji,jj,jk) * tmask(ji,jj,jk) 271 263 ! 272 264 zmsku = 1./MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 273 265 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk), 1. ) 274 275 266 zmskv = 1./MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 276 267 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk), 1. ) 277 268 ! 278 269 zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 279 270 zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 280 271 ! 281 272 ztfw(ji,jj,jk) = zcoef3 * ( zdit(ji ,jj ,jk-1) + zdit(ji-1,jj ,jk) & 282 273 & + zdit(ji-1,jj ,jk-1) + zdit(ji ,jj ,jk) ) & … … 290 281 ! I.5 Divergence of vertical fluxes added to the general tracer trend 291 282 ! ------------------------------------------------------------------- 292 293 283 DO jk = 1, jpkm1 294 284 DO jj = 2, jpjm1 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2082 r2104 13 13 !! 3.0 ! 10-06 (C. Ethe, G. Madec) Merge TRA-TRC 14 14 !!---------------------------------------------------------------------- 15 15 16 !!---------------------------------------------------------------------- 16 17 !! tra_ldf_lap : update the tracer trend with the horizontal diffusion 17 18 !! using a iso-level harmonic (laplacien) operator. 18 19 !!---------------------------------------------------------------------- 19 !! * Modules used20 20 USE oce ! ocean dynamics and active tracers 21 21 USE dom_oce ! ocean space and time domain … … 25 25 USE trc_oce ! share passive tracers/Ocean variables 26 26 27 28 27 IMPLICIT NONE 29 28 PRIVATE 30 29 31 !! * Routine accessibility 32 PUBLIC tra_ldf_lap ! routine called by step.F90 30 PUBLIC tra_ldf_lap ! routine called by step.F90 33 31 34 32 REAL(wp), DIMENSION(jpi,jpj) :: e1ur, e2vr ! scale factor coefficients … … 40 38 !!---------------------------------------------------------------------- 41 39 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 !! $Id$ 40 !! $Id$ 43 41 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 44 42 !!---------------------------------------------------------------------- … … 46 44 CONTAINS 47 45 48 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, &46 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, & 49 47 & ptb, pta, kjpt ) 50 48 !!---------------------------------------------------------------------- … … 68 66 !! harmonic mixing trend. 69 67 !!---------------------------------------------------------------------- 70 !!71 68 USE oce , ztu => ua ! use ua as workspace 72 69 USE oce , ztv => va ! use va as workspace 73 70 !! 74 INTEGER , INTENT(in ) :: kt! ocean time-step index75 CHARACTER(len=3) , INTENT(in ) :: cdtype! =TRA or TRC (tracer indicator)76 INTEGER , INTENT(in ) :: kjpt! number of tracers77 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pgu, pgv! tracer gradient at pstep levels78 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb! before and now tracer fields79 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend71 INTEGER , INTENT(in ) :: kt ! ocean time-step index 72 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 73 INTEGER , INTENT(in ) :: kjpt ! number of tracers 74 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 75 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 76 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 80 77 !! 81 INTEGER :: ji, jj, jk, jn ! dummy loop indices 82 INTEGER :: iku, ikv ! temporary integers 83 REAL(wp) :: & 84 zabe1, zabe2, ztra, zbtr ! temporary scalars 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices 79 INTEGER :: iku, ikv ! local integers 80 REAL(wp) :: zabe1, zabe2, zbtr ! local scalars 85 81 !!---------------------------------------------------------------------- 86 82 87 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN83 IF( kt == nit000 ) THEN 88 84 IF(lwp) WRITE(numout,*) 89 85 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype … … 93 89 ENDIF 94 90 95 ! 96 DO jn = 1, kjpt ! tracer loop 97 ! ! =========== 98 ! 99 DO jk = 1, jpkm1 91 ! ! =========== ! 92 DO jn = 1, kjpt ! tracer loop ! 93 ! ! =========== ! 94 DO jk = 1, jpkm1 ! slab loop 100 95 ! 101 96 ! 1. First derivative (gradient) … … 133 128 DO ji = fs_2, fs_jpim1 ! vector opt. 134 129 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 135 ! horizontal diffusive trends 136 ztra = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 137 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 138 ! add it to the general tracer trends 139 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 130 ! horizontal diffusive trends added to the general tracer trends 131 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 132 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 140 133 END DO 141 134 END DO 142 ! ! =============135 ! 143 136 END DO ! End of slab 144 ! ! =============137 ! 145 138 ! "Poleward" diffusive heat or salt transports 146 139 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN … … 148 141 IF( jn == jp_sal) pst_ldf(:) = ptr_vj( ztv(:,:,:) ) 149 142 ENDIF 150 ! 151 END DO 152 ! 143 ! ! ================== 144 END DO ! end of tracer loop 145 ! ! ================== 153 146 END SUBROUTINE tra_ldf_lap 154 147 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranpc.F90
r2082 r2104 8 8 !! NEMO 1.0 ! 2002-06 (G. Madec) free form F90 9 9 !! 3.0 ! 2008-06 (G. Madec) applied on ta, sa and called before tranxt in step.F90 10 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 10 11 !!---------------------------------------------------------------------- 11 12 … … 55 56 !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 56 57 !!---------------------------------------------------------------------- 57 !!58 58 INTEGER, INTENT(in) :: kt ! ocean time-step index 59 59 !! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranxt.F90
r2083 r2104 15 15 !! 3.0 ! 2008-06 (G. Madec) time stepping always done in trazdf 16 16 !! 3.1 ! 2009-02 (G. Madec, R. Benshila) re-introduce the vvl option 17 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 17 18 !!---------------------------------------------------------------------- 18 19 … … 87 88 !! 88 89 INTEGER :: jk ! dummy loop indices 89 REAL(wp) :: zfact ! temporaryscalars90 REAL(wp) :: zfact ! local scalars 90 91 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 91 92 92 !!---------------------------------------------------------------------- 93 93 … … 131 131 132 132 ! Leap-Frog + Asselin filter time stepping 133 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000,tsb, tsn, tsa, jpts ) ! variable volume level (vvl)134 ELSE ; CALL tra_nxt_fix( kt, nit000,tsb, tsn, tsa, jpts ) ! fixed volume level133 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, tsb, tsn, tsa, jpts ) ! variable volume level (vvl) 134 ELSE ; CALL tra_nxt_fix( kt, tsb, tsn, tsa, jpts ) ! fixed volume level 135 135 ENDIF 136 136 … … 160 160 END SUBROUTINE tra_nxt 161 161 162 SUBROUTINE tra_nxt_fix( kt, kit000, & 163 & ptb, ptn, pta, kjpt)162 163 SUBROUTINE tra_nxt_fix( kt, ptb, ptn, pta, kjpt ) 164 164 !!---------------------------------------------------------------------- 165 165 !! *** ROUTINE tra_nxt_fix *** … … 184 184 !!---------------------------------------------------------------------- 185 185 INTEGER , INTENT(in ) :: kt ! ocean time-step index 186 INTEGER , INTENT(in ) :: kit000 ! first time-step index187 186 INTEGER , INTENT(in ) :: kjpt ! number of tracers 188 187 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields … … 194 193 !!---------------------------------------------------------------------- 195 194 196 IF( kt == kit000 ) THEN195 IF( kt == nit000 ) THEN 197 196 IF(lwp) WRITE(numout,*) 198 197 IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping' … … 204 203 ! ! ----------------------- ! 205 204 ! 206 IF( neuler == 0 .AND. kt == kit000 ) THEN ! Euler time-stepping at first time-step205 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 207 206 ! ! (only swap) 208 207 DO jn = 1, kjpt … … 234 233 ! ! ----------------------- ! 235 234 ! 236 IF( neuler == 0 .AND. kt == kit000 ) THEN ! Euler time-stepping at first time-step235 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 237 236 DO jn = 1, kjpt 238 237 DO jk = 1, jpkm1 … … 262 261 END SUBROUTINE tra_nxt_fix 263 262 264 SUBROUTINE tra_nxt_vvl( kt, kit000, & 265 & ptb, ptn, pta, kjpt)263 264 SUBROUTINE tra_nxt_vvl( kt, ptb, ptn, pta, kjpt ) 266 265 !!---------------------------------------------------------------------- 267 266 !! *** ROUTINE tra_nxt_vvl *** … … 288 287 !!---------------------------------------------------------------------- 289 288 INTEGER , INTENT(in ) :: kt ! ocean time-step index 290 INTEGER , INTENT(in ) :: kit000 ! first time-step index291 289 INTEGER , INTENT(in ) :: kjpt ! number of tracers 292 290 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields … … 300 298 !!---------------------------------------------------------------------- 301 299 302 IF( kt == kit000 ) THEN300 IF( kt == nit000 ) THEN 303 301 IF(lwp) WRITE(numout,*) 304 302 IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping' … … 310 308 ! ! ----------------------- ! 311 309 ! 312 IF( neuler == 0 .AND. kt == kit000 ) THEN ! Euler time-stepping at first time-step310 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler time-stepping at first time-step 313 311 DO jn = 1, kjpt ! (only swap) 314 312 DO jk = 1, jpkm1 … … 358 356 ! ! ----------------------- ! 359 357 ! 360 IF( neuler == 0 .AND. kt == kit000 ) THEN ! case of Euler time-stepping at first time-step358 IF( neuler == 0 .AND. kt == nit000 ) THEN ! case of Euler time-stepping at first time-step 361 359 DO jn = 1, kjpt ! No filter nor thickness weighting computation required 362 360 DO jk = 1, jpkm1 ! ONLY swap -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trasbc.F90
r2052 r2104 4 4 !! Ocean active tracers: surface boundary condition 5 5 !!============================================================================== 6 !! History : 8.2 ! 98-10 (G. Madec, G. Roullet, M. Imbard) Original code 7 !! 8.2 ! 01-02 (D. Ludicone) sea ice and free surface 8 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 6 !! History : OPA ! 1998-10 (G. Madec, G. Roullet, M. Imbard) Original code 7 !! 8.2 ! 2001-02 (D. Ludicone) sea ice and free surface 8 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 9 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 9 10 !!---------------------------------------------------------------------- 10 11 … … 33 34 # include "vectopt_loop_substitute.h90" 34 35 !!---------------------------------------------------------------------- 35 !! OPA 9.0 , LOCEAN-IPSL (2005)36 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 36 37 !! $Id$ 37 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 100 101 !! - save the trend it in ttrd ('key_trdtra') 101 102 !!---------------------------------------------------------------------- 102 !! 103 INTEGER, INTENT(in) :: kt ! ocean time-step index 104 !! 105 INTEGER :: ji, jj, jk ! dummy loop indices 106 REAL(wp) :: zta, zsa ! temporary scalars, adjustment to temperature and salinity 107 REAL(wp) :: zata, zasa ! temporary scalars, calculations of automatic change to temp & sal due to vvl (done elsewhere) 108 REAL(wp) :: zsrau, zse3t, zdep ! temporary scalars, 1/density, 1/height of box, 1/height of effected water column 103 INTEGER, INTENT(in) :: kt ! ocean time-step index 104 !! 105 INTEGER :: ji, jj, jk ! dummy loop indices 106 REAL(wp) :: zta, zsa ! local scalars, adjustment to temperature and salinity 107 REAL(wp) :: zata, zasa ! local scalars, calculations of automatic change to temp & sal due to vvl (done elsewhere) 108 REAL(wp) :: zsrau, zse3t, zdep ! local scalars, 1/density, 1/height of box, 1/height of effected water column 109 109 REAL(wp) :: zdheat, zdsalt ! total change of temperature and salinity 110 110 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds … … 136 136 #endif 137 137 IF( lk_vvl) THEN 138 zta = ro0cpr * qns(ji,jj) * zse3t & ! temperature : heat flux 139 & - emp(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) * zse3t ! & cooling/heating effet of EMP flux 140 zsa = ( emps(ji,jj) - emp(ji,jj) ) & 141 & * zsrau * tsn(ji,jj,1,jp_sal) * zse3t ! concent./dilut. effect due to sea-ice 142 ! melt/formation and (possibly) SSS restoration 138 ! temperature : heat flux and heat content of EMP flux 139 zta = ( ro0cpr * qns(ji,jj) - emp(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) ) * zse3t 140 ! Salinity : concent./dilut. effect due to sea-ice melt/formation and (possibly) SSS restoration 141 zsa = ( emps(ji,jj) - emp(ji,jj) ) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t 143 142 ELSE 144 zta = ro0cpr * qns(ji,jj) * zse3t ! temperature : heat flux145 zsa = emps(ji,jj) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t 143 zta = ro0cpr * qns(ji,jj) * zse3t ! temperature : heat flux 144 zsa = emps(ji,jj) * zsrau * tsn(ji,jj,1,jp_sal) * zse3t ! salinity : concent./dilut. effect 146 145 ENDIF 147 146 tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta ! add the trend to the general tracer trend … … 150 149 END DO 151 150 152 IF ( ln_rnf .AND. ln_rnf_att ) THEN 153 ! Concentration / dilution effect on (t,s) due to river runoff 151 IF( ln_rnf .AND. ln_rnf_att ) THEN ! Concentration / dilution effect on (t,s) due to river runoff 154 152 DO jj = 1, jpj 155 153 DO ji = 1, jpi 156 rnf_dep(ji,jj) = 0. 154 rnf_dep(ji,jj) = 0.e0 157 155 DO jk = 1, rnf_mod_dep(ji,jj) ! recalculates rnf_dep to be the depth 158 156 rnf_dep(ji,jj) = rnf_dep(ji,jj) + fse3t(ji,jj,jk) ! in metres to the bottom of the relevant grid box 159 END DO157 END DO 160 158 zdep = 1. / rnf_dep(ji,jj) 161 159 zse3t= 1. / fse3t(ji,jj,1) 162 IF ( rnf_tmp(ji,jj) == -999 ) rnf_tmp(ji,jj) = tsn(ji,jj,1,jp_tem)! if not specified set runoff temp to be sst163 164 IF ( rnf(ji,jj) > 0.0 ) THEN160 IF( rnf_tmp(ji,jj) == -999 ) rnf_tmp(ji,jj) = tsn(ji,jj,1,jp_tem) ! if not specified set runoff temp to be sst 161 162 IF( rnf(ji,jj) > 0.e0 ) THEN 165 163 166 164 IF( lk_vvl ) THEN 167 165 ! indirect flux, concentration or dilution effect : force a dilution effect in all levels 168 zdheat = 0. 0169 zdsalt = 0. 0166 zdheat = 0.e0 167 zdsalt = 0.e0 170 168 DO jk = 1, rnf_mod_dep(ji,jj) 171 169 zta = -tsn(ji,jj,jk,jp_tem) * rnf(ji,jj) * zsrau * zdep 172 170 zsa = -tsn(ji,jj,jk,jp_sal) * rnf(ji,jj) * zsrau * zdep 173 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 171 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta ! add the trend to the general tracer trend 174 172 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 175 173 zdheat = zdheat + zta * fse3t(ji,jj,jk) 176 174 zdsalt = zdsalt + zsa * fse3t(ji,jj,jk) 177 END DO178 ! negate this total change in heat and salt content from top level 175 END DO 176 ! negate this total change in heat and salt content from top level !!gm I don't understand this 179 177 zta = -zdheat * zse3t 180 178 zsa = -zdsalt * zse3t 181 tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta 179 tsa(ji,jj,1,jp_tem) = tsa(ji,jj,1,jp_tem) + zta ! add the trend to the general tracer trend 182 180 tsa(ji,jj,1,jp_sal) = tsa(ji,jj,1,jp_sal) + zsa 183 181 … … 187 185 188 186 DO jk = 1, rnf_mod_dep(ji,jj) 189 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 187 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta ! add the trend to the general tracer trend 190 188 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 191 ENDDO 192 189 END DO 193 190 ELSE 194 191 DO jk = 1, rnf_mod_dep(ji,jj) 195 192 zta = ( rnf_tmp(ji,jj) - tsn(ji,jj,jk,jp_tem) ) * rnf(ji,jj) * zsrau * zdep 196 193 zsa = ( rnf_sal(ji,jj) - tsn(ji,jj,jk,jp_sal) ) * rnf(ji,jj) * zsrau * zdep 197 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 194 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta ! add the trend to the general tracer trend 198 195 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 199 END DO196 END DO 200 197 ENDIF 201 198 202 ELSE IF( rnf(ji,jj) < 0.) THEN ! for use in baltic when flow is out of domain, want no change in temp and sal199 ELSEIF( rnf(ji,jj) < 0.e0) THEN ! for use in baltic when flow is out of domain, want no change in temp and sal 203 200 204 201 IF( lk_vvl ) THEN … … 212 209 ENDIF 213 210 214 END DO215 END DO216 217 ELSE IF( ln_rnf ) THEN 218 219 ! Concentration dilution effect on (t,s) due to runoff without temperatue, salinity and depth attributes 211 END DO 212 END DO 213 214 ELSE IF( ln_rnf ) THEN ! Concentration dilution effect on (t,s) due to runoff without T, S and depth attributes 215 216 220 217 DO jj = 2, jpj 221 218 DO ji = fs_2, fs_jpim1 ! vector opt. … … 225 222 IF( lk_vvl) THEN 226 223 zta = rnf(ji,jj) * zsrau * tsn(ji,jj,1,jp_tem) * zse3t ! & cooling/heating effect of runoff 227 zsa = 0.e0 ! No salinity concent./dilut. effect224 zsa = 0.e0 ! No salinity concent./dilut. effect 228 225 ELSE 229 226 zta = 0.0 ! temperature : heat flux -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traswp.F90
r2034 r2104 4 4 !! Ocean active tracers: swapping array 5 5 !!============================================================================== 6 USE par_oce 6 USE par_oce ! ocean parameters 7 7 USE oce ! ocean dynamics and active tracers 8 8 … … 15 15 !!---------------------------------------------------------------------- 16 16 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 17 !! $Id: traswap.F90 2024 2010-07-29 10:57:35Z cetlod$17 !! $Id: $ 18 18 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 19 19 !!---------------------------------------------------------------------- … … 28 28 !! 29 29 !!---------------------------------------------------------------------- 30 30 ! 31 31 tsn(:,:,:,jp_tem) = tn(:,:,:) ; tsn(:,:,:,jp_sal) = sn(:,:,:) 32 32 tsb(:,:,:,jp_tem) = tb(:,:,:) ; tsb(:,:,:,jp_sal) = sb(:,:,:) 33 33 tsa(:,:,:,jp_tem) = ta(:,:,:) ; tsa(:,:,:,jp_sal) = sa(:,:,:) 34 34 ! 35 35 END SUBROUTINE tra_swap 36 36 … … 42 42 !! 43 43 !!---------------------------------------------------------------------- 44 44 ! 45 45 tn(:,:,:) = tsn(:,:,:,jp_tem) ; sn(:,:,:) = tsn(:,:,:,jp_sal) 46 46 tb(:,:,:) = tsb(:,:,:,jp_tem) ; sb(:,:,:) = tsb(:,:,:,jp_sal) 47 47 ta(:,:,:) = tsa(:,:,:,jp_tem) ; sa(:,:,:) = tsa(:,:,:,jp_sal) 48 48 ! 49 49 END SUBROUTINE tra_unswap 50 50 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf.F90
r2082 r2104 4 4 !! Ocean active tracers: vertical component of the tracer mixing trend 5 5 !!============================================================================== 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code7 !! NEMO3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA6 !! History : 1.0 ! 2005-11 (G. Madec) Original code 7 !! 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 8 !!---------------------------------------------------------------------- 9 9 10 10 !!---------------------------------------------------------------------- 11 11 !! tra_zdf : Update the tracer trend with the vertical diffusion 12 !! zdf_ctl : ???12 !! tra_zdf_init : initialisation of the computation 13 13 !!---------------------------------------------------------------------- 14 14 USE oce ! ocean dynamics and tracers variables … … 47 47 # include "vectopt_loop_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 49 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 50 50 !! $Id$ 51 51 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 61 61 !!--------------------------------------------------------------------- 62 62 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 63 !! 64 64 INTEGER :: jk ! Dummy loop indices 65 65 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace … … 124 124 !!---------------------------------------------------------------------- 125 125 126 ! Define the vertical tracer physics scheme127 ! ==========================================128 129 126 ! Choice from ln_zdfexp already read in namelist in zdfini module 130 IF( ln_zdfexp ) THEN ! use explicit scheme 131 nzdf = 0 132 ELSE ! use implicit scheme 133 nzdf = 1 127 IF( ln_zdfexp ) THEN ; nzdf = 0 ! use explicit scheme 128 ELSE ; nzdf = 1 ! use implicit scheme 134 129 ENDIF 135 130 … … 138 133 IF( ln_traldf_iso ) nzdf = 1 ! iso-neutral lateral physics 139 134 IF( ln_traldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 140 141 IF( ln_zdfexp .AND. nzdf == 1 ) THEN 142 CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator or TKE ', & 143 & ' or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) 144 ENDIF 135 IF( ln_zdfexp .AND. nzdf == 1 ) CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator', & 136 & ' TKE or KPP scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) 145 137 146 138 ! Test: esopa … … 155 147 IF( nzdf == 1 ) WRITE(numout,*) ' Implicit (euler backward) scheme' 156 148 ENDIF 157 149 ! 158 150 END SUBROUTINE tra_zdf_init 159 151 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r2082 r2104 41 41 # include "vectopt_loop_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 !! NEMO/OPA 44 !! $Id$ 43 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 44 !! $Id$ 45 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- … … 48 48 CONTAINS 49 49 50 SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp, &50 SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp, & 51 51 & ptb , pta , kjpt ) 52 52 !!---------------------------------------------------------------------- … … 73 73 !! ** Action : - after tracer fields pta 74 74 !!--------------------------------------------------------------------- 75 !! 76 INTEGER , INTENT(in ) :: kt ! ocean time-step index 77 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 78 INTEGER , INTENT(in ) :: kjpt ! number of tracers 79 INTEGER , INTENT(in ) :: kn_zdfexp ! number of sub-time step 80 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 81 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 82 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 75 INTEGER , INTENT(in ) :: kt ! ocean time-step index 76 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 77 INTEGER , INTENT(in ) :: kjpt ! number of tracers 78 INTEGER , INTENT(in ) :: kn_zdfexp ! number of sub-time step 79 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 81 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 83 82 !! 84 83 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 85 REAL(wp) :: zlavmr, zave3r, ze3tr ! temporaryscalars86 REAL(wp) :: ztra, ze3tb ! temporary scalars84 REAL(wp) :: zlavmr, zave3r, ze3tr ! local scalars 85 REAL(wp) :: ztra, ze3tb ! - - 87 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwx, zwy ! 3D workspace 88 87 !!--------------------------------------------------------------------- 89 88 90 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN89 IF( kt == nit000 ) THEN 91 90 IF(lwp) WRITE(numout,*) 92 91 IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype … … 96 95 ! Initializations 97 96 ! --------------- 98 zlavmr = 1. / float( kn_zdfexp ) 97 zlavmr = 1. / float( kn_zdfexp ) ! Local constant 99 98 ! 100 99 ! 101 DO jn = 1, kjpt 100 DO jn = 1, kjpt ! loop over tracers 102 101 ! 103 102 zwy(:,:, 1 ) = 0.e0 ! surface boundary conditions: no flux -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r2082 r2104 89 89 !! 90 90 !!--------------------------------------------------------------------- 91 !!92 91 USE oce , ONLY : zwd => ua ! ua used as workspace 93 92 USE oce , ONLY : zws => va ! va - - 94 93 !! 95 INTEGER , INTENT(in ) :: kt! ocean time-step index96 CHARACTER(len=3) , INTENT(in ) :: cdtype! =TRA or TRC (tracer indicator)97 INTEGER , INTENT(in ) :: kjpt! number of tracers98 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt! vertical profile of tracer time-step99 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb! before and now tracer fields100 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta! tracer trend94 INTEGER , INTENT(in ) :: kt ! ocean time-step index 95 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 96 INTEGER , INTENT(in ) :: kjpt ! number of tracers 97 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 98 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 99 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 101 100 !! 102 101 INTEGER :: ji, jj, jk, jn ! dummy loop indices 103 REAL(wp) :: zavi, zrhs, znvvl ! temporaryscalars102 REAL(wp) :: zavi, zrhs, znvvl ! local scalars 104 103 REAL(wp) :: ze3tb, ze3tn, ze3ta ! variable vertical scale factors 105 104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwt ! workspace arrays 106 105 !!--------------------------------------------------------------------- 107 106 108 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 )) THEN107 IF( kt == nit000 ) THEN 109 108 IF(lwp)WRITE(numout,*) 110 109 IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype … … 287 286 DO ji = fs_2, fs_jpim1 288 287 pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) ) & 289 &/ zwt(ji,jj,jk) * tmask(ji,jj,jk)288 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 290 289 END DO 291 290 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90
r2082 r2104 4 4 !! z-coordinate - partial step : Horizontal Derivative 5 5 !!============================================================================== 6 !! History : 7 !! OPA 8.5 ! 2002-04 (A. Bozec) Original code 8 !! 8.5 ! 2002-08 (G. Madec E. Durand) Optimization and Free form 9 !! 9.0 ! 2004-03 (C. Ethe) adapted for passive tracers 10 !! NEMO 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 6 !! History : OPA ! 2002-04 (A. Bozec) Original code 7 !! 8.5 ! 2002-08 (G. Madec E. Durand) Optimization and Free form 8 !! NEMO 1.0 ! 2004-03 (C. Ethe) adapted for passive tracers 9 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 11 10 !!============================================================================== 12 11 … … 15 14 !! ocean level (Z-coord. with Partial Steps) 16 15 !!---------------------------------------------------------------------- 17 !! * Modules used18 16 USE dom_oce ! ocean space domain variables 19 17 USE oce ! ocean dynamics and tracers variables … … 26 24 PRIVATE 27 25 28 !! * Routine accessibility 29 PUBLIC zps_hde ! routine called by step.F90 30 PUBLIC zps_hde_init ! routine called by opa.F90 31 32 !! * module variables 33 INTEGER, DIMENSION(jpi,jpj) :: & 34 mbatu, mbatv ! bottom ocean level index at U- and V-points 26 PUBLIC zps_hde ! routine called by step.F90 27 PUBLIC zps_hde_init ! routine called by opa.F90 28 29 INTEGER, DIMENSION(jpi,jpj) :: mbatu, mbatv ! bottom ocean level index at U- and V-points 35 30 36 31 !! * Substitutions … … 38 33 # include "vectopt_loop_substitute.h90" 39 34 !!---------------------------------------------------------------------- 40 !!---------------------------------------------------------------------- 41 !! OPA 9.0 , LOCEAN-IPSL (2005) 42 !! $Id$ 43 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 35 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 36 !! $Id$ 37 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 38 !!---------------------------------------------------------------------- 45 39 CONTAINS … … 90 84 !! and rd at V-points 91 85 !!---------------------------------------------------------------------- 92 !! * Arguments 93 INTEGER , INTENT( in ) :: kt ! ocean time-step index 94 INTEGER , INTENT( in ) :: kjpt ! number of tracers 95 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in ) :: pta ! 4D active or passive tracers fields 96 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! horizontal grad. of ptra u- and v-points 97 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( in ), OPTIONAL :: prd ! 3D rd fields 98 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! horizontal grad. of prd u- and v-points 99 !! * Local declarations 86 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 INTEGER , INTENT(in ) :: kjpt ! number of tracers 88 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 89 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 90 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 91 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad. of prd at u- & v-pts 92 !! 100 93 INTEGER :: ji, jj, jn ! Dummy loop indices 101 94 INTEGER :: iku, ikv ! partial step level at u- and v-points … … 109 102 ! Interpolation of tracers at the last ocean level 110 103 DO jn = 1, kjpt 104 ! 111 105 # if defined key_vectopt_loop 112 106 jj = 1 … … 155 149 # endif 156 150 END DO 157 158 ! Lateral boundary conditions on each gradient 159 CALL lbc_lnk( pgtu(:,:,jn) , 'U', -1. ) 160 CALL lbc_lnk( pgtv(:,:,jn) , 'V', -1. ) 161 151 CALL lbc_lnk( pgtu(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtv(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 152 ! 162 153 END DO 163 154 164 ! horizontal derivative of rd 165 IF( PRESENT( prd ) ) THEN 166 ! depth of the partial step level 155 ! horizontal derivative of density anomalies (rd) 156 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 167 157 # if defined key_vectopt_loop 168 158 jj = 1 … … 193 183 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 194 184 ! step and store it in zri, zrj for each case 195 CALL eos( zti, zhi, zri ) 196 CALL eos( ztj, zhj, zrj ) 185 CALL eos( zti, zhi, zri ) ; CALL eos( ztj, zhj, zrj ) 197 186 198 187 ! Gradient of density at the last level … … 222 211 # endif 223 212 END DO 224 225 ! Lateral boundary conditions on each gradient 226 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) 213 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 227 214 ! 228 215 END IF … … 230 217 END SUBROUTINE zps_hde 231 218 219 232 220 SUBROUTINE zps_hde_init 233 221 !!---------------------------------------------------------------------- … … 237 225 !! 238 226 !!---------------------------------------------------------------------- 239 !! * Local declarations 240 INTEGER :: ji, jj ! Dummy loop indices 241 REAL(wp), DIMENSION(jpi,jpj) :: zti, ztj ! temporary arrays 242 !!---------------------------------------------------------------------- 243 227 INTEGER :: ji, jj ! Dummy loop indices 228 REAL(wp), DIMENSION(jpi,jpj) :: zti, ztj ! 2D workspace 229 !!---------------------------------------------------------------------- 230 ! 244 231 mbatu(:,:) = 0 245 232 mbatv(:,:) = 0 … … 253 240 ztj(:,:) = FLOAT( mbatv(:,:) ) 254 241 ! lateral boundary conditions: T-point, sign unchanged 255 CALL lbc_lnk( zti , 'U', 1. ) 256 CALL lbc_lnk( ztj , 'V', 1. ) 242 CALL lbc_lnk( zti , 'U', 1. ) ; CALL lbc_lnk( ztj , 'V', 1. ) 257 243 mbatu(:,:) = MAX( INT( zti(:,:) ), 2 ) 258 244 mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 ) 259 245 ! 260 246 END SUBROUTINE zps_hde_init 261 247 !!====================================================================== -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdicp.F90
r2082 r2104 4 4 !! Ocean diagnostics: ocean tracers and dynamic trends 5 5 !!===================================================================== 6 !! History : ! 91-12 (G. Madec) 7 !! ! 92-06 (M. Imbard) add time step frequency 8 !! ! 96-01 (G. Madec) terrain following coordinates 9 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 10 !! 9.0 ! 04-08 (C. Talandier) New trends organization 6 !! History : 1.0 ! 2004-08 (C. Talandier) New trends organization 11 7 !!---------------------------------------------------------------------- 12 8 #if defined key_trdtra || defined key_trddyn || defined key_esopa … … 14 10 !! 'key_trdtra' or active tracers trends diagnostics 15 11 !! 'key_trddyn' momentum trends diagnostics 16 !!----------------------------------------------------------------------17 12 !!---------------------------------------------------------------------- 18 13 !! trd_icp : compute the basin averaged properties for tra/dyn … … 48 43 # include "vectopt_loop_substitute.h90" 49 44 !!---------------------------------------------------------------------- 50 !! OPA 9.0 , LOCEAN-IPSL (2005)51 !! $Id$ 45 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 46 !! $Id$ 52 47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 53 48 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdmod.F90
r2026 r2104 4 4 !! Ocean diagnostics: ocean tracers and dynamic trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 04-08 (C. Talandier) Original code 7 !! ! 05-04 (C. Deltel) Add Asselin trend in the ML budget 6 !! History : 1.0 ! 2004-08 (C. Talandier) Original code 7 !! - ! 2005-04 (C. Deltel) Add Asselin trend in the ML budget 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa … … 36 37 # include "vectopt_loop_substitute.h90" 37 38 !!---------------------------------------------------------------------- 38 !! OPA 9.0 , LOCEAN-IPSL (2005)39 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 39 40 !! $Id$ 40 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 216 217 217 218 ENDIF 218 219 ! 219 220 END SUBROUTINE trd_mod 220 221 221 # 222 #else 222 223 !!---------------------------------------------------------------------- 223 224 !! Default case : Empty module … … 230 231 CONTAINS 231 232 SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt ) ! Empty routine 232 REAL, DIMENSION(:,:,:), INTENT( in ) :: & 233 ptrd3dx, & ! Temperature or U trend 234 ptrd3dy ! Salinity or V trend 235 INTEGER, INTENT( in ) :: ktrd ! momentum or tracer trend index 236 INTEGER, INTENT( in ) :: kt ! Time step 237 CHARACTER(len=3), INTENT( in ) :: ctype ! momentum or tracers trends type 238 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1) 239 WRITE(*,*) ' " ": You should not have seen this print! error ?', ptrd3dy(1,1,1) 240 WRITE(*,*) ' " ": You should not have seen this print! error ?', ktrd 241 WRITE(*,*) ' " ": You should not have seen this print! error ?', ctype 242 WRITE(*,*) ' " ": You should not have seen this print! error ?', kt 233 REAL :: ptrd3dx(:,:,:), ptrd3dy(:,:,:) 234 INTEGER :: ktrd, kt 235 CHARACTER(len=3) :: ctype 236 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1) 237 WRITE(*,*) ' " ": You should not have seen this print! error ?', ktrd, ctype, kt 243 238 END SUBROUTINE trd_mod 244 # 239 #endif 245 240 246 241 SUBROUTINE trd_mod_init … … 251 246 !!---------------------------------------------------------------------- 252 247 USE in_out_manager ! I/O manager 253 248 !! 254 249 NAMELIST/namtrd/ nn_trd, nn_ctls, cn_trdrst_in, cn_trdrst_out, ln_trdmld_restart, rn_ucf, ln_trdmld_instant 255 250 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdmod_oce.F90
r2026 r2104 4 4 !! Ocean trends : set tracer and momentum trend variables 5 5 !!====================================================================== 6 !! History : 9.0 !04-08 (C. Talandier) Original code6 !! History : 1.0 ! 2004-08 (C. Talandier) Original code 7 7 !!---------------------------------------------------------------------- 8 8 USE trdicp_oce ! ocean momentum/tracers bassin properties trends variables … … 38 38 LOGICAL , PUBLIC :: l_trdtrc = .FALSE. !: tracers trend flag 39 39 # endif 40 ! !!!Active tracers trends indexes41 INTEGER, PUBLIC, PARAMETER :: jptra_trd_xad = 1 !: x- horizontal advection42 INTEGER, PUBLIC, PARAMETER :: jptra_trd_yad = 2 !: y- horizontal advection43 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zad = 3 !: z- vertical advection44 INTEGER, PUBLIC, PARAMETER :: jptra_trd_ldf = 4 !: lateral diffusion45 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zdf = 5 !: vertical diffusion (Kz)46 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbc = 6 !: Bottom Boundary Condition (geoth. flux)47 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbl = 7 !: Bottom Boundary Layer (diffusive/convective)48 INTEGER, PUBLIC, PARAMETER :: jptra_trd_npc = 8 !: static instability mixing49 INTEGER, PUBLIC, PARAMETER :: jptra_trd_dmp = 9 !: damping50 INTEGER, PUBLIC, PARAMETER :: jptra_trd_qsr = 10 !: penetrative solar radiation51 INTEGER, PUBLIC, PARAMETER :: jptra_trd_nsr = 11 !: non solar radiation52 INTEGER, PUBLIC, PARAMETER :: jptra_trd_atf = 12 !: Asselin correction40 ! !!!* Active tracers trends indexes 41 INTEGER, PUBLIC, PARAMETER :: jptra_trd_xad = 1 !: x- horizontal advection 42 INTEGER, PUBLIC, PARAMETER :: jptra_trd_yad = 2 !: y- horizontal advection 43 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zad = 3 !: z- vertical advection 44 INTEGER, PUBLIC, PARAMETER :: jptra_trd_ldf = 4 !: lateral diffusion 45 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zdf = 5 !: vertical diffusion (Kz) 46 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbc = 6 !: Bottom Boundary Condition (geoth. flux) 47 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbl = 7 !: Bottom Boundary Layer (diffusive/convective) 48 INTEGER, PUBLIC, PARAMETER :: jptra_trd_npc = 8 !: static instability mixing 49 INTEGER, PUBLIC, PARAMETER :: jptra_trd_dmp = 9 !: damping 50 INTEGER, PUBLIC, PARAMETER :: jptra_trd_qsr = 10 !: penetrative solar radiation 51 INTEGER, PUBLIC, PARAMETER :: jptra_trd_nsr = 11 !: non solar radiation 52 INTEGER, PUBLIC, PARAMETER :: jptra_trd_atf = 12 !: Asselin correction 53 53 #if defined key_top 54 ! !* Passive tracers trends indexes55 INTEGER, PUBLIC, PARAMETER :: jptra_trd_sms = 13 !: sources m. sinks56 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radn = 14 !: corr. trn<0 in trcrad57 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radb = 15 !: corr. trb<0 in trcrad (like atf)54 ! !!!* Passive tracers trends indexes 55 INTEGER, PUBLIC, PARAMETER :: jptra_trd_sms = 13 !: sources m. sinks 56 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radn = 14 !: corr. trn<0 in trcrad 57 INTEGER, PUBLIC, PARAMETER :: jptra_trd_radb = 15 !: corr. trb<0 in trcrad (like atf) 58 58 #endif 59 59 60 ! !!!Momentum trends indexes61 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_hpg = 1 !: hydrostatic pressure gradient62 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_keg = 2 !: kinetic energy gradient63 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_rvo = 3 !: relative vorticity64 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_pvo = 4 !: planetary vorticity65 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_ldf = 5 !: lateral diffusion66 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_had = 6 !: horizontal advection67 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zad = 7 !: vertical advection68 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zdf = 8 !: vertical diffusion69 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_spg = 9 !: surface pressure gradient70 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_dat = 10 !: damping term71 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_swf = 11 !: surface wind forcing72 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_bfr = 12 !: bottom friction60 ! !!!* Momentum trends indexes 61 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_hpg = 1 !: hydrostatic pressure gradient 62 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_keg = 2 !: kinetic energy gradient 63 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_rvo = 3 !: relative vorticity 64 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_pvo = 4 !: planetary vorticity 65 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_ldf = 5 !: lateral diffusion 66 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_had = 6 !: horizontal advection 67 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zad = 7 !: vertical advection 68 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_zdf = 8 !: vertical diffusion 69 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_spg = 9 !: surface pressure gradient 70 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_dat = 10 !: damping term 71 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_swf = 11 !: surface wind forcing 72 INTEGER, PUBLIC, PARAMETER :: jpdyn_trd_bfr = 12 !: bottom friction 73 73 74 74 !!---------------------------------------------------------------------- 75 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)76 !! $Id$ 75 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 76 !! $Id$ 77 77 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 78 78 !!====================================================================== -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdmod_trc.F90
r2026 r2104 5 5 !!====================================================================== 6 6 !!---------------------------------------------------------------------- 7 !! Dummy module NO TOP use7 !! Dummy module NO TOP use 8 8 !!---------------------------------------------------------------------- 9 9 CONTAINS 10 10 11 11 SUBROUTINE trd_mod_trc( ptrtrd, kjn, ktrd, kt ) 12 INTEGER , INTENT( in ) :: kt ! time step 13 INTEGER , INTENT( in ) :: kjn ! tracer index 14 INTEGER , INTENT( in ) :: ktrd ! tracer trend index 15 REAL, DIMENSION(:,:,:), INTENT( in ) :: ptrtrd ! Temperature or U trend 12 INTEGER :: kt, kjn, ktrd 13 REAL :: ptrtrd(:,:,:) 16 14 WRITE(*,*) 'trd_mod_trc_trp : You should not have seen this print! error?', ptrtrd(1,1,1) 17 WRITE(*,*) ' " " : You should not have seen this print! error?', kjn 18 WRITE(*,*) ' " " : You should not have seen this print! error?', ktrd 19 WRITE(*,*) ' " " : You should not have seen this print! error?', kt 15 WRITE(*,*) ' " " : You should not have seen this print! error?', kjn, ktrd, kt 20 16 END SUBROUTINE trd_mod_trc 21 17 18 !!====================================================================== 22 19 END MODULE trdmod_trc -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r2027 r2104 7 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 8 !! 3.2 ! 2009-09 (A.C.Coward) Correction to include barotropic contribution 9 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 9 10 !!---------------------------------------------------------------------- 10 11 … … 12 13 !! zdf_bfr : update momentum Kz at the ocean bottom due to the type of bottom friction chosen 13 14 !! zdf_bfr_init : read in namelist and control the bottom friction parameters. 14 !! zdf_bfr_2d : read in namelist and control the bottom friction 15 !! parameters. 15 !! zdf_bfr_2d : read in namelist and control the bottom friction parameters. 16 16 !!---------------------------------------------------------------------- 17 17 USE oce ! ocean dynamics and tracers variables … … 44 44 # include "domzgr_substitute.h90" 45 45 !!---------------------------------------------------------------------- 46 !! NEMO/OPA 3 .2 , LOCEAN-IPSL (2009)47 !! $Id$ 46 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 47 !! $Id$ 48 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfddm.F90
r2027 r2104 6 6 !! History : OPA ! 2000-08 (G. Madec) double diffusive mixing 7 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_zdfddm || defined key_esopa … … 39 40 # include "vectopt_loop_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3 .2 , LOCEAN-IPSL (2009)42 !! $Id$ 42 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 43 !! $Id$ 43 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 45 !!---------------------------------------------------------------------- … … 97 98 DO ji = 1, jpi 98 99 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 99 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN 100 zmsks(ji,jj) = 0.e0 101 ELSE 102 zmsks(ji,jj) = 1.e0 100 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0.e0 101 ELSE ; zmsks(ji,jj) = 1.e0 103 102 ENDIF 104 103 ! salt fingering indicator: msksf=1 if rrau>1; 0 elsewhere 105 IF( rrau(ji,jj,jk) <= 1. ) THEN 106 zmskf(ji,jj) = 0.e0 107 ELSE 108 zmskf(ji,jj) = 1.e0 104 IF( rrau(ji,jj,jk) <= 1. ) THEN ; zmskf(ji,jj) = 0.e0 105 ELSE ; zmskf(ji,jj) = 1.e0 109 106 ENDIF 110 107 ! diffusive layering indicators: 111 ! mskdl1=1 if 0<rrau<1; 0 elsewhere 112 IF( rrau(ji,jj,jk) >= 1. ) THEN 113 zmskd1(ji,jj) = 0.e0 114 ELSE 115 zmskd1(ji,jj) = 1.e0 116 ENDIF 117 ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 118 IF( rrau(ji,jj,jk) >= 0.5 ) THEN 119 zmskd2(ji,jj) = 0.e0 120 ELSE 121 zmskd2(ji,jj) = 1.e0 108 ! ! mskdl1=1 if 0<rrau<1; 0 elsewhere 109 IF( rrau(ji,jj,jk) >= 1. ) THEN ; zmskd1(ji,jj) = 0.e0 110 ELSE ; zmskd1(ji,jj) = 1.e0 111 ENDIF 112 ! ! mskdl2=1 if 0<rrau<0.5; 0 elsewhere 113 IF( rrau(ji,jj,jk) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0.e0 114 ELSE ; zmskd2(ji,jj) = 1.e0 122 115 ENDIF 123 116 ! mskdl3=1 if 0.5<rrau<1; 0 elsewhere 124 IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN 125 zmskd3(ji,jj) = 0.e0 126 ELSE 127 zmskd3(ji,jj) = 1.e0 117 IF( rrau(ji,jj,jk) <= 0.5 .OR. rrau(ji,jj,jk) >= 1. ) THEN ; zmskd3(ji,jj) = 0.e0 118 ELSE ; zmskd3(ji,jj) = 1.e0 128 119 ENDIF 129 120 END DO … … 226 217 WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt 227 218 END SUBROUTINE zdf_ddm 219 SUBROUTINE zdf_ddm_init ! Dummy routine 220 END SUBROUTINE zdf_ddm_init 228 221 #endif 229 222 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r2027 r2104 5 5 !! turbulent closure parameterization 6 6 !!===================================================================== 7 !! History : 8.1 ! 00-03 (W.G. Large, J. Chanut) Original code 8 !! 8.1 ! 02-06 (J.M. Molines) for real case CLIPPER 9 !! 8.2 ! 03-10 (Chanut J.) re-writting 10 !! 9.0 ! 05-01 (C. Ethe) Free form, F90 7 !! History : OPA ! 2000-03 (W.G. Large, J. Chanut) Original code 8 !! 8.1 ! 2002-06 (J.M. Molines) for real case CLIPPER 9 !! 8.2 ! 2003-10 (Chanut J.) re-writting 10 !! NEMO 1.0 ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine 11 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_zdfkpp || defined key_esopa … … 14 15 !! 'key_zdfkpp' KPP scheme 15 16 !!---------------------------------------------------------------------- 16 !!----------------------------------------------------------------------17 17 !! zdf_kpp : update momentum and tracer Kz from a kpp scheme 18 18 !! zdf_kpp_init : initialization, namelist read, and parameters control 19 !! tra_kpp : compute and add to the T & S trend the non-local flux 20 !! trc_kpp : compute and add to the passive tracer trend the non-local flux (lk_top=T) 19 21 !!---------------------------------------------------------------------- 20 22 USE oce ! ocean dynamics and active tracers … … 58 60 59 61 #if defined key_zdfddm 60 REAL(wp) :: &!!! ** Double diffusion Mixing61 difssf = 1.e-03_wp , &! maximum salt fingering mixing62 Rrho0 = 1.9_wp , &! limit for salt fingering mixing63 difsdc = 1.5e-06_wp! maximum diffusive convection mixing62 ! !!! ** Double diffusion Mixing 63 REAL(wp) :: difssf = 1.e-03_wp ! maximum salt fingering mixing 64 REAL(wp) :: Rrho0 = 1.9_wp ! limit for salt fingering mixing 65 REAL(wp) :: difsdc = 1.5e-06_wp ! maximum diffusive convection mixing 64 66 #endif 65 67 LOGICAL :: ln_kpprimix = .TRUE. ! Shear instability mixing 66 68 67 REAL(wp) :: & !!! ** General constants ** 68 epsln = 1.0e-20_wp , & ! a small positive number 69 pthird = 1._wp/3._wp , & ! 1/3 70 pfourth = 1._wp/4._wp ! 1/4 71 72 REAL(wp) :: & !!! ** Boundary Layer Turbulence Parameters ** 73 vonk = 0.4_wp , & ! von Karman's constant 74 epsilon = 0.1_wp , & ! nondimensional extent of the surface layer 75 rconc1 = 5.0_wp , & ! standard flux profile function parmaeters 76 rconc2 = 16.0_wp , & ! " " 77 rconcm = 8.38_wp , & ! momentum flux profile fit 78 rconam = 1.26_wp , & ! " " 79 rzetam = -.20_wp , & ! " " 80 rconcs = 98.96_wp , & ! scalar flux profile fit 81 rconas = -28.86_wp , & ! " " 82 rzetas = -1.0_wp ! " " 83 REAL(wp) :: & !!! ** Boundary Layer Depth Diagnostic ** 84 Ricr = 0.3_wp , & ! critical bulk Richardson Number 85 rcekman = 0.7_wp , & ! coefficient for ekman depth 86 rcmonob = 1.0_wp , & ! coefficient for Monin-Obukhov depth 87 rconcv = 1.7_wp , & ! ratio of interior buoyancy frequency to buoyancy frequency at entrainment depth 88 hbf = 1.0_wp , & ! fraction of bound. layer depth to which absorbed solar 89 ! ! rad. and contributes to surf. buo. forcing 90 Vtc ! function of rconcv,rconcs,epsilon,vonk,Ricr 91 REAL(wp) :: & !!! ** Nonlocal Boundary Layer Mixing ** 92 rcstar = 5.0_wp , & ! coefficient for convective nonlocal transport 93 rcs = 1.0e-3_wp , & ! conversion: mm/s ==> m/s 94 rcg ! non-dimensional coefficient for nonlocal transport 69 ! !!! ** General constants ** 70 REAL(wp) :: epsln = 1.0e-20_wp ! a small positive number 71 REAL(wp) :: pthird = 1._wp/3._wp ! 1/3 72 REAL(wp) :: pfourth = 1._wp/4._wp ! 1/4 73 74 ! !!! ** Boundary Layer Turbulence Parameters ** 75 REAL(wp) :: vonk = 0.4_wp ! von Karman's constant 76 REAL(wp) :: epsilon = 0.1_wp ! nondimensional extent of the surface layer 77 REAL(wp) :: rconc1 = 5.0_wp ! standard flux profile function parmaeters 78 REAL(wp) :: rconc2 = 16.0_wp ! " " 79 REAL(wp) :: rconcm = 8.38_wp ! momentum flux profile fit 80 REAL(wp) :: rconam = 1.26_wp ! " " 81 REAL(wp) :: rzetam = -.20_wp ! " " 82 REAL(wp) :: rconcs = 98.96_wp ! scalar flux profile fit 83 REAL(wp) :: rconas = -28.86_wp ! " " 84 REAL(wp) :: rzetas = -1.0_wp ! " " 85 86 ! !!! ** Boundary Layer Depth Diagnostic ** 87 REAL(wp) :: Ricr = 0.3_wp ! critical bulk Richardson Number 88 REAL(wp) :: rcekman = 0.7_wp ! coefficient for ekman depth 89 REAL(wp) :: rcmonob = 1.0_wp ! coefficient for Monin-Obukhov depth 90 REAL(wp) :: rconcv = 1.7_wp ! ratio of interior buoyancy frequency to its value at entrainment depth 91 REAL(wp) :: hbf = 1.0_wp ! fraction of bound. layer depth to which absorbed solar 92 ! ! rad. and contributes to surf. buo. forcing 93 REAL(wp) :: Vtc ! function of rconcv,rconcs,epsilon,vonk,Ricr 94 95 ! !!! ** Nonlocal Boundary Layer Mixing ** 96 REAL(wp) :: rcstar = 5.0_wp ! coefficient for convective nonlocal transport 97 REAL(wp) :: rcs = 1.0e-3_wp ! conversion: mm/s ==> m/s 98 REAL(wp) :: rcg ! non-dimensional coefficient for nonlocal transport 95 99 96 100 #if ! defined key_kppcustom 97 REAL(wp), DIMENSION(jpk,jpk) :: del ! array for reference mean values of vertical integration101 REAL(wp), DIMENSION(jpk,jpk) :: del ! array for reference mean values of vertical integration 98 102 #endif 99 103 100 104 #if defined key_kpplktb 101 INTEGER, PARAMETER :: & !!! ** Parameters for lookup table for turbulent velocity scales ** 102 nilktb = 892 , & ! number of values for zehat in KPP lookup table 103 njlktb = 482 , & ! number of values for ustar in KPP lookup table 104 nilktbm1 = nilktb - 1 , & ! 105 njlktbm1 = njlktb - 1 ! 106 107 REAL(wp), DIMENSION(nilktb,njlktb) :: wmlktb ! lookup table for the turbulent vertical velocity scale for momentum 108 REAL(wp), DIMENSION(nilktb,njlktb) :: wslktb ! lookup table for the turbulent vertical velocity scale for tracers 109 110 REAL(wp) :: & 111 dehatmin = -4.e-7_wp , & ! minimum limit for zhat in lookup table (m3/s3) 112 dehatmax = 0._wp , & ! maximum limit for zhat in lookup table (m3/s3) 113 ustmin = 0._wp , & ! minimum limit for ustar in lookup table (m/s) 114 ustmax = 0.04_wp , & ! maximum limit for ustar in lookup table (m/s) 115 dezehat , & ! delta zhat in lookup table 116 deustar ! delta ustar in lookup table 105 ! !!! ** Parameters for lookup table for turbulent velocity scales ** 106 INTEGER, PARAMETER :: nilktb = 892 ! number of values for zehat in KPP lookup table 107 INTEGER, PARAMETER :: njlktb = 482 ! number of values for ustar in KPP lookup table 108 INTEGER, PARAMETER :: nilktbm1 = nilktb-1 ! 109 INTEGER, PARAMETER :: njlktbm1 = njlktb-1 ! 110 111 REAL(wp), DIMENSION(nilktb,njlktb) :: wmlktb ! lookup table for the turbulent vertical velocity scale (momentum) 112 REAL(wp), DIMENSION(nilktb,njlktb) :: wslktb ! lookup table for the turbulent vertical velocity scale (tracers) 113 114 REAL(wp) :: dehatmin = -4.e-7_wp ! minimum limit for zhat in lookup table (m3/s3) 115 REAL(wp) :: dehatmax = 0._wp ! maximum limit for zhat in lookup table (m3/s3) 116 REAL(wp) :: ustmin = 0._wp ! minimum limit for ustar in lookup table (m/s) 117 REAL(wp) :: ustmax = 0.04_wp ! maximum limit for ustar in lookup table (m/s) 118 REAL(wp) :: dezehat ! delta zhat in lookup table 119 REAL(wp) :: deustar ! delta ustar in lookup table 117 120 #endif 118 121 REAL(wp), DIMENSION(jpk) :: ratt ! attenuation coef (already defines in module traqsr, 119 122 ! ! but only if the solar radiation penetration is considered) 120 REAL(wp) :: & !!! * penetrative solar radiation coefficient * 121 rabs = 0.58_wp , & ! fraction associated with xsi1 122 xsi1 = 0.35_wp , & ! first depth of extinction 123 xsi2 = 23.0_wp ! second depth of extinction 123 124 ! !!! * penetrative solar radiation coefficient * 125 REAL(wp) :: rabs = 0.58_wp ! fraction associated with xsi1 126 REAL(wp) :: xsi1 = 0.35_wp ! first depth of extinction 127 REAL(wp) :: xsi2 = 23.0_wp ! second depth of extinction 124 128 ! ! (default values: water type Ib) 125 129 126 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 127 etmean , & ! coefficient used for horizontal smoothing 128 eumean , & ! at t-, u- and v-points 129 evmean 130 REAL(wp), DIMENSION(jpi,jpj,jpk) :: etmean, eumean, evmean ! coeff. used for hor. smoothing at t-, u- & v-points 131 130 132 131 133 #if defined key_c1d 132 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & 133 rig , & ! gradient Richardson number 134 rib , & ! bulk Richardson number 135 buof , & ! buoyancy forcing 136 mols ! moning-Obukhov length scale 137 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ekdp ! Ekman depth 134 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rig !: gradient Richardson number 135 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rib !: bulk Richardson number 136 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: buof !: buoyancy forcing 137 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mols !: moning-Obukhov length scale 138 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ekdp !: Ekman depth 138 139 #endif 139 140 … … 145 146 # include "zdfddm_substitute.h90" 146 147 !!---------------------------------------------------------------------- 147 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)148 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 148 149 !! $Id$ 149 150 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 152 153 CONTAINS 153 154 154 SUBROUTINE zdf_kpp 155 SUBROUTINE zdf_kpp( kt ) 155 156 !!---------------------------------------------------------------------- 156 157 !! *** ROUTINE zdf_kpp *** … … 188 189 !!---------------------------------------------------------------------- 189 190 #if defined key_zdfddm 190 USE oce , zviscos => ua , &! temp. array for viscosities use ua as workspace191 & zdiffut => ta, &! temp. array for diffusivities use sa as workspace192 & zdiffus => sa! temp. array for diffusivities use sa as workspace191 USE oce , zviscos => ua ! temp. array for viscosities use ua as workspace 192 USE oce , zdiffut => ta ! temp. array for diffusivities use sa as workspace 193 USE oce , zdiffus => sa ! temp. array for diffusivities use sa as workspace 193 194 #else 194 USE oce , zviscos => ua , &! temp. array for viscosities use ua as workspace195 & zdiffut => ta! temp. array for diffusivities use sa as workspace195 USE oce , zviscos => ua ! temp. array for viscosities use ua as workspace 196 USE oce , zdiffut => ta ! temp. array for diffusivities use sa as workspace 196 197 #endif 197 198 !! … … 201 202 INTEGER :: ikbot, jkmax, jkm1, jkp2 ! 202 203 203 REAL(wp), DIMENSION(jpi,jpj) :: & !!! Surface buoyancy forcing, friction velocity 204 zBo, zBosol, zustar ! 205 ! 206 REAL(wp) :: & ! 207 ztx, zty, zflageos, & ! 208 zstabl, zbuofdep,zucube, & ! 209 zrhos, zalbet, zbeta, & ! 210 zthermal, zhalin, zatt1 ! 211 212 REAL(wp) :: & !!! Bulk richardson number 213 zref, zt, zs, zh, & ! 214 zu, zv, zrh, & ! 215 zrib, zrinum, & ! 216 zdVsq, zVtsq ! 217 218 REAL(wp) :: & !!! Velocity scales 219 zehat, zeta, zhrib, zsig, & ! 220 zscale, zwst, zws, zwm 221 204 REAL(wp), DIMENSION(jpi,jpj) :: zBo, zBosol, zustar ! Surface buoyancy forcing, friction velocity 205 REAL(wp) :: ztx, zty, zflageos, zstabl, zbuofdep,zucube ! 206 REAL(wp) :: zrhos, zalbet, zbeta, zthermal, zhalin, zatt1 ! 207 REAL(wp) :: zref, zt, zs, zh, zu, zv, zrh ! Bulk richardson number 208 REAL(wp) :: zrib, zrinum, zdVsq, zVtsq ! 209 REAL(wp) :: zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm ! Velocity scales 222 210 #if defined key_kpplktb 223 INTEGER :: & !!! Lookup table or Analytical functions 224 il, jl ! 225 REAL(wp) :: & ! 226 ud, zfrac, ufrac, & ! 227 zwam, zwbm, zwas, zwbs ! 211 INTEGER :: il, jl ! Lookup table or Analytical functions 212 REAL(wp) :: ud, zfrac, ufrac, zwam, zwbm, zwas, zwbs ! 228 213 #else 229 REAL(wp) :: & ! 230 zwsun, zwmun, & 231 zcons, zconm, zwcons, zwconm ! 232 #endif 233 234 REAL(wp) :: & !!! In situ density 235 zsr, zbw, ze, & ! 236 zb, zd, zc, zaw, za, & ! 237 zb1, za1, zkw, zk0, & ! 238 zcomp , zrhd, zrhdr,zbvzed ! 239 214 REAL(wp) :: zwsun, zwmun, zcons, zconm, zwcons, zwconm ! 215 #endif 216 REAL(wp) :: zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed ! In situ density 240 217 #if ! defined key_kppcustom 241 !! * local declarations 242 INTEGER :: & 243 jm ! dummy loop indices 244 REAL(wp) :: & !!! Compression terms 245 zr1, zr2, zr3, zr4, & ! 246 zrhop ! 247 #endif 248 249 REAL(wp) :: & ! 250 zflag, ztemp, zrn2, & ! 251 zdep21, zdep32, zdep43 252 253 REAL(wp) :: & !!! Interior richardson mixing 254 zdku2, zdkv2, ze3sqr, & ! 255 zsh2, zri, zfri ! 256 257 REAL(wp), DIMENSION(jpi,0:2) :: & !!! Moning-Obukov limitation 258 zmoek 259 REAL(wp), DIMENSION(jpi) :: & 260 zmoa, zekman 261 REAL(wp) :: & 262 zmob, zek 263 264 REAL(wp), DIMENSION(jpi,4) :: & !!! The pipe 265 zdepw, zdift, zvisc 266 REAL(wp), DIMENSION(jpi,3) :: & 267 zdept 268 REAL(wp), DIMENSION(jpi,2) :: & 269 zriblk 270 REAL(wp), DIMENSION(jpi,jpk) :: & ! 271 zmask 272 REAL(wp), DIMENSION(jpi) :: & ! 273 zhmax, zria, zhbl 274 REAL(wp) :: & ! 275 zflagri, zflagek, & ! 276 zflagmo, zflagh, zflagkb ! 277 REAL(wp), DIMENSION(jpi) :: & !!! Shape function (G) 278 za2m, za3m, zkmpm, & 279 za2t, za3t, zkmpt 280 REAL(wp) :: & ! 281 zdelta, zdelta2, & ! 282 zdzup, zdzdn, zdzh, & ! 283 zvath, zgat1, zdat1, & ! 284 zkm1m, zkm1t 285 REAL(wp), DIMENSION(jpi,jpk) :: & !!! Boundary layer diffusivities/viscosities 286 zblcm, zblct 218 INTEGER :: jm ! dummy loop indices 219 REAL(wp) :: zr1, zr2, zr3, zr4, zrhop ! Compression terms 220 #endif 221 REAL(wp) :: zflag, ztemp, zrn2, zdep21, zdep32, zdep43 222 REAL(wp) :: zdku2, zdkv2, ze3sqr, zsh2, zri, zfri ! Interior richardson mixing 223 REAL(wp), DIMENSION(jpi,0:2) :: zmoek ! Moning-Obukov limitation 224 REAL(wp), DIMENSION(jpi) :: zmoa, zekman 225 REAL(wp) :: zmob, zek 226 REAL(wp), DIMENSION(jpi,4) :: zdepw, zdift, zvisc ! The pipe 227 REAL(wp), DIMENSION(jpi,3) :: zdept 228 REAL(wp), DIMENSION(jpi,2) :: zriblk 229 REAL(wp), DIMENSION(jpi,jpk) :: zmask 230 REAL(wp), DIMENSION(jpi) :: zhmax, zria, zhbl 231 REAL(wp) :: zflagri, zflagek, zflagmo, zflagh, zflagkb ! 232 REAL(wp), DIMENSION(jpi) :: za2m, za3m, zkmpm, za2t, za3t, zkmpt ! Shape function (G) 233 REAL(wp) :: zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 234 REAL(wp), DIMENSION(jpi,jpk) :: zblcm, zblct ! Boundary layer diffusivities/viscosities 287 235 #if defined key_zdfddm 288 REAL(wp) :: & !!! double diffusion mixing 289 zrrau, zds, & 290 zavdds, zavddt,zinr 291 REAL(wp), DIMENSION(jpi,4) :: & 292 zdifs 293 REAL(wp), DIMENSION(jpi) :: & 294 za2s, za3s, zkmps 295 REAL(wp) :: & 296 zkm1s 297 REAL(wp), DIMENSION(jpi,jpk) :: & 298 zblcs 236 REAL(wp) :: zrrau, zds, zavdds, zavddt,zinr ! double diffusion mixing 237 REAL(wp), DIMENSION(jpi,4) :: zdifs 238 REAL(wp), DIMENSION(jpi) :: za2s, za3s, zkmps 239 REAL(wp) :: zkm1s 240 REAL(wp), DIMENSION(jpi,jpk) :: zblcs 299 241 #endif 300 242 !!-------------------------------------------------------------------- 301 302 303 ! Initialization (first time-step only)304 ! --------------305 IF( kt == nit000 ) CALL zdf_kpp_init306 243 307 244 zviscos(:,:,:) = 0. … … 1241 1178 !! *** ROUTINE tra_kpp *** 1242 1179 !! 1243 !! ** Purpose : compute and add to the tracer trend the non-local 1244 !! tracer flux 1180 !! ** Purpose : compute and add to the tracer trend the non-local tracer flux 1245 1181 !! 1246 1182 !! ** Method : ??? 1247 !!1248 !! history :1249 !! 1.0 ! 2005-11 (G. Madec) Original code1250 !! 3.3 ! 2010-06 (C. Ethe) Merge TRA-TRC1251 1183 !!---------------------------------------------------------------------- 1252 !! * Modules used1253 1184 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 1254 1185 !!---------------------------------------------------------------------- … … 1375 1306 !! 1376 1307 !! ** input : Namlist namkpp 1377 !!1378 !!1379 !! history :1380 !! 8.1 ! 00-02 (J. Chanut) KPP Mixing1381 !! 9.0 ! 05-01 (C. Ethe) F90 : free form1382 1308 !!---------------------------------------------------------------------- 1383 !! * local declarations 1384 1385 INTEGER :: & 1386 ji, jj, jk ! dummy loop indices 1387 1309 INTEGER :: ji, jj, jk ! dummy loop indices 1388 1310 #if ! defined key_kppcustom 1389 INTEGER :: & 1390 jm ! dummy loop indices 1391 REAL(wp) :: & !!! tempory scalars 1392 zref, zdist 1393 #endif 1394 1311 INTEGER :: jm ! dummy loop indices 1312 REAL(wp) :: zref, zdist ! tempory scalars 1313 #endif 1395 1314 #if defined key_kpplktb 1396 REAL(wp) :: & !!! tempory scalars 1397 zustar, & 1398 zucube, zustvk, & 1399 zeta, zehat 1400 #endif 1401 REAL(wp) :: & !!! tempory scalars 1402 zhbf 1403 LOGICAL :: & 1404 ll_kppcustom, & ! 1st ocean level taken as surface layer 1405 ll_kpplktb ! Lookup table for turbul. velocity scales 1315 REAL(wp) :: zustar, zucube, zustvk, zeta, zehat ! tempory scalars 1316 #endif 1317 REAL(wp) :: zhbf ! tempory scalars 1318 LOGICAL :: ll_kppcustom ! 1st ocean level taken as surface layer 1319 LOGICAL :: ll_kpplktb ! Lookup table for turbul. velocity scales 1406 1320 !! 1407 1321 NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave … … 1610 1524 LOGICAL, PUBLIC, PARAMETER :: lk_zdfkpp = .FALSE. !: KPP flag 1611 1525 CONTAINS 1612 SUBROUTINE zdf_kpp( kt ) ! Empty routine 1526 SUBROUTINE zdf_kpp_init ! Dummy routine 1527 WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?' 1528 END SUBROUTINE zdf_kpp_init 1529 SUBROUTINE zdf_kpp( kt ) ! Dummy routine 1613 1530 WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt 1614 1531 END SUBROUTINE zdf_kpp 1615 SUBROUTINE tra_kpp( kt ) ! Empty routine1532 SUBROUTINE tra_kpp( kt ) ! Dummy routine 1616 1533 WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt 1617 1534 END SUBROUTINE tra_kpp -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdfric.F90
r2027 r2104 10 10 !! 8.0 ! 1997-06 (G. Madec) complete rewriting of zdfmix 11 11 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 12 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_zdfric || defined key_esopa … … 43 44 # include "domzgr_substitute.h90" 44 45 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)46 !! $Id$ 46 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 47 !! $Id$ 47 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 48 49 !!---------------------------------------------------------------------- … … 192 193 LOGICAL, PUBLIC, PARAMETER :: lk_zdfric = .FALSE. !: Richardson mixing flag 193 194 CONTAINS 195 SUBROUTINE zdf_ric_init ! Dummy routine 196 END SUBROUTINE zdf_ric_init 194 197 SUBROUTINE zdf_ric( kt ) ! Dummy routine 195 198 WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdftke.F90
r2027 r2104 25 25 !! 3.2 ! 2009-06 (G. Madec, S. Masson) TKE restart compatible with key_cpl 26 26 !! ! + cleaning of the parameters + bugs correction 27 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 27 28 !!---------------------------------------------------------------------- 28 29 #if defined key_zdftke || defined key_esopa … … 30 31 !! 'key_zdftke' TKE vertical physics 31 32 !!---------------------------------------------------------------------- 32 !! zdf_tke 33 !! tke_tke 34 !! tke_avn 35 !! tke_init: initialization, namelist read, and parameters control36 !! tke_rst 33 !! zdf_tke : update momentum and tracer Kz from a tke scheme 34 !! tke_tke : tke time stepping: update tke at now time step (en) 35 !! tke_avn : compute mixing length scale and deduce avm and avt 36 !! zdf_tke_init : initialization, namelist read, and parameters control 37 !! tke_rst : read/write tke restart in ocean restart file 37 38 !!---------------------------------------------------------------------- 38 39 USE oce ! ocean dynamics and active tracers … … 53 54 PRIVATE 54 55 55 PUBLIC zdf_tke ! routine called in step module56 PUBLIC tke_init ! routine called in opa module57 PUBLIC tke_rst ! routine called in step module56 PUBLIC zdf_tke ! routine called in step module 57 PUBLIC zdf_tke_init ! routine called in opa module 58 PUBLIC tke_rst ! routine called in step module 58 59 59 60 LOGICAL , PUBLIC, PARAMETER :: lk_zdftke = .TRUE. !: TKE vertical mixing flag … … 95 96 # include "vectopt_loop_substitute.h90" 96 97 !!---------------------------------------------------------------------- 97 !! NEMO/OPA 3 .2 , LOCEAN-IPSL (2009)98 !! $Id: zdftke2.F90 1201 2008-09-24 13:24:21Z rblod$98 !! NEMO/OPA 3,3 , LOCEAN-IPSL (2010) 99 !! $Id: $ 99 100 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 100 101 !!---------------------------------------------------------------------- … … 150 151 !!---------------------------------------------------------------------- 151 152 ! 152 153 154 153 CALL tke_tke ! now tke (en) 154 ! 155 CALL tke_avn ! now avt, avm, avmu, avmv 155 156 ! 156 157 END SUBROUTINE zdf_tke … … 655 656 656 657 657 SUBROUTINE tke_init658 SUBROUTINE zdf_tke_init 658 659 !!---------------------------------------------------------------------- 659 !! *** ROUTINE tke_init ***660 !! *** ROUTINE zdf_tke_init *** 660 661 !! 661 662 !! ** Purpose : Initialization of the vertical eddy diffivity and … … 685 686 IF(lwp) THEN !* Control print 686 687 WRITE(numout,*) 687 WRITE(numout,*) 'zdf_tke : tke turbulent closure scheme - initialisation'688 WRITE(numout,*) '~~~~~~~~ '688 WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme - initialisation' 689 WRITE(numout,*) '~~~~~~~~~~~~' 689 690 WRITE(numout,*) ' Namelist namzdf_tke : set tke mixing parameters' 690 691 WRITE(numout,*) ' coef. to compute avt rn_ediff = ', rn_ediff … … 747 748 CALL tke_rst( nit000, 'READ' ) 748 749 ! 749 END SUBROUTINE tke_init750 END SUBROUTINE zdf_tke_init 750 751 751 752 … … 824 825 LOGICAL, PUBLIC, PARAMETER :: lk_zdftke = .FALSE. !: TKE flag 825 826 CONTAINS 826 SUBROUTINE zdf_tke( kt ) ! Empty routine 827 SUBROUTINE zdf_tke_init ! Dummy routine 828 END SUBROUTINE zdf_tke_init 829 SUBROUTINE zdf_tke( kt ) ! Dummy routine 827 830 WRITE(*,*) 'zdf_tke: You should not have seen this print! error?', kt 828 831 END SUBROUTINE zdf_tke -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdftke_old.F90
r2027 r2104 48 48 PRIVATE 49 49 50 PUBLIC zdf_tke_old ! routine called in step module51 PUBLIC zdf_tke_init ! routine called in opa module50 PUBLIC zdf_tke_old ! routine called in step module 51 PUBLIC zdf_tke_init_o ! routine called in opa module 52 52 53 53 LOGICAL , PUBLIC, PARAMETER :: lk_zdftke_old = .TRUE. !: TKE vertical mixing flag … … 696 696 697 697 698 SUBROUTINE zdf_tke_init 698 SUBROUTINE zdf_tke_init_o 699 699 !!---------------------------------------------------------------------- 700 !! *** ROUTINE zdf_tke_init ***700 !! *** ROUTINE zdf_tke_init_o *** 701 701 !! 702 702 !! ** Purpose : Initialization of the vertical eddy diffivity and … … 743 743 IF(lwp) THEN 744 744 WRITE(numout,*) 745 WRITE(numout,*) 'zdf_tke_init : tke turbulent closure scheme (old scheme)'746 WRITE(numout,*) '~~~~~~~~~~~~ '745 WRITE(numout,*) 'zdf_tke_init_o : tke turbulent closure scheme (old scheme)' 746 WRITE(numout,*) '~~~~~~~~~~~~~~' 747 747 WRITE(numout,*) ' Namelist namzdf_tke : set tke mixing parameters' 748 748 WRITE(numout,*) ' restart with tke from no tke ln_rstke = ', ln_rstke … … 853 853 CALL tke_rst( nit000, 'READ' ) 854 854 ! 855 END SUBROUTINE zdf_tke_init 855 END SUBROUTINE zdf_tke_init_o 856 856 857 857 … … 901 901 LOGICAL, PUBLIC, PARAMETER :: lk_zdftke_old = .FALSE. !: TKE flag 902 902 CONTAINS 903 SUBROUTINE zdf_tke_old( kt ) ! Empty routine 903 SUBROUTINE zdf_tke_init_o ! Dummy routine 904 END SUBROUTINE zdf_tke_init_o 905 SUBROUTINE zdf_tke_old( kt ) ! Dummy routine 904 906 WRITE(*,*) 'zdf_tke_old: You should not have seen this print! error?', kt 905 907 END SUBROUTINE zdf_tke_old -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/ZDF/zdftmx.F90
r2027 r2104 6 6 !! History : 1.0 ! 2004-04 (L. Bessieres, G. Madec) Original code 7 7 !! - ! 2006-08 (A. Koch-Larrouy) Indonesian strait 8 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_zdftmx … … 48 49 # include "vectopt_loop_substitute.h90" 49 50 !!---------------------------------------------------------------------- 50 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)51 !! $Id $51 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 52 !! $Id: $ 52 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 53 54 !!---------------------------------------------------------------------- … … 486 487 ! 487 488 ENDIF 488 489 ! 489 490 END SUBROUTINE zdf_tmx_init 490 491 … … 495 496 LOGICAL, PUBLIC, PARAMETER :: lk_zdftmx = .FALSE. !: tidal mixing flag 496 497 CONTAINS 497 SUBROUTINE zdf_tmx( kt ) ! Empty routine 498 SUBROUTINE zdf_tmx_init ! Dummy routine 499 WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?' 500 END SUBROUTINE zdf_tmx_init 501 SUBROUTINE zdf_tmx( kt ) ! Dummy routine 498 502 WRITE(*,*) 'zdf_tmx: You should not have seen this print! error?', kt 499 503 END SUBROUTINE zdf_tmx -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/cla.F90
r2027 r2104 763 763 USE in_out_manager ! I/O manager 764 764 CONTAINS 765 SUBROUTINE tra_cla_init 766 END SUBROUTINE tra_cla_init 765 767 SUBROUTINE tra_cla( kt ) 766 768 INTEGER, INTENT(in) :: kt ! ocean time-step indice -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/istate.F90
r2084 r2104 4 4 !! Ocean state : initial state setting 5 5 !!===================================================================== 6 !! History : 4.0 !89-12 (P. Andrich) Original code7 !! 5.0 !91-11 (G. Madec) rewritting8 !! 6.0 !96-01 (G. Madec) terrain following coordinates9 !! 8.0 !01-09 (M. Levy, M. Ben Jelloul) istate_eel10 !! 8.0 !01-09 (M. Levy, M. Ben Jelloul) istate_uvg11 !! 9.0 ! 03-08 (G. Madec) F90: Free form, modules12 !! 9.0 ! 03-09 (G. Madec, C. Talandier) add EEL R513 !! 9.0 ! 04-05 (A. Koch-Larrouy) istate_gyre14 !! 9.0 ! 06-07 (S. Masson) distributed restart using iom6 !! History : OPA ! 1989-12 (P. Andrich) Original code 7 !! 5.0 ! 1991-11 (G. Madec) rewritting 8 !! 6.0 ! 1996-01 (G. Madec) terrain following coordinates 9 !! 8.0 ! 2001-09 (M. Levy, M. Ben Jelloul) istate_eel 10 !! 8.0 ! 2001-09 (M. Levy, M. Ben Jelloul) istate_uvg 11 !! NEMO 1.0 ! 2003-08 (G. Madec, C. Talandier) F90: Free form, modules + EEL R5 12 !! - ! 2004-05 (A. Koch-Larrouy) istate_gyre 13 !! 2.0 ! 2006-07 (S. Masson) distributed restart using iom 14 !! 3.3 ! 2010-10 (C. Ethe) merge TRC-TRA 15 15 !!---------------------------------------------------------------------- 16 16 … … 25 25 USE oce ! ocean dynamics and active tracers 26 26 USE dom_oce ! ocean space and time domain 27 USE daymod ! 27 USE daymod ! calendar 28 USE eosbn2 ! eq. of state, Brunt Vaisala frequency (eos routine) 28 29 USE ldftra_oce ! ocean active tracers: lateral physics 29 30 USE zdf_oce ! ocean vertical physics … … 33 34 USE restart ! ocean restart (rst_read routine) 34 35 USE in_out_manager ! I/O manager 35 USE iom 36 USE iom ! I/O library 36 37 USE c1d ! re-initialization of u-v mask for the 1D configuration 37 38 USE zpshde ! partial step: hor. derivative (zps_hde routine) … … 53 54 # include "vectopt_loop_substitute.h90" 54 55 !!---------------------------------------------------------------------- 55 !! OPA 9.0 , LOCEAN-IPSL (2006)56 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 56 57 !! $Id$ 57 58 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 66 67 !! ** Purpose : Initialization of the dynamics and tracer fields. 67 68 !!---------------------------------------------------------------------- 68 USE eosbn2 ! eq. of state, Brunt Vaisala frequency (eos routine)69 69 70 70 IF(lwp) WRITE(numout,*) … … 82 82 neuler = 1 ! Set time-step indicator at nit000 (leap-frog) 83 83 CALL rst_read ! Read the restart file 84 CALL tra_swap ! swap 3D arrays (t a,sa) in a 4D array84 CALL tra_swap ! swap 3D arrays (t,s) in a 4D array (ts) 85 85 CALL day_init ! model calendar (using both namelist and restart infos) 86 86 ELSE … … 91 91 CALL day_init ! model calendar (using both namelist and restart infos) 92 92 ! ! Initialization of ocean to zero 93 ! before fields ! now fields 94 ub (:,:,:) = 0.e0 ; un (:,:,:) = 0.e0 ; sshb(:,:) = 0.e0 95 vb (:,:,:) = 0.e0 ; vn (:,:,:) = 0.e0 ; sshn(:,:) = 0.e0 96 rotb (:,:,:) = 0.e0 ; rotn (:,:,:) = 0.e0 97 hdivb(:,:,:) = 0.e0 ; hdivn(:,:,:) = 0.e0 93 ! before fields ! now fields 94 sshb (:,:) = 0.e0 ; sshn (:,:) = 0.e0 95 ub (:,:,:) = 0.e0 ; un (:,:,:) = 0.e0 96 vb (:,:,:) = 0.e0 ; vn (:,:,:) = 0.e0 97 rotb (:,:,:) = 0.e0 ; rotn (:,:,:) = 0.e0 98 hdivb(:,:,:) = 0.e0 ; hdivn(:,:,:) = 0.e0 98 99 ! 99 100 IF( cp_cfg == 'eel' ) THEN 100 CALL istate_eel ! EEL configuration : start from pre-defined 101 ! ! velocity and thermohaline fields 101 CALL istate_eel ! EEL configuration : start from pre-defined U,V T-S fields 102 102 ELSEIF( cp_cfg == 'gyre' ) THEN 103 CALL istate_gyre ! GYRE configuration : start from pre-defined temperature 104 ! ! and salinity fields 103 CALL istate_gyre ! GYRE configuration : start from pre-defined T-S fields 105 104 ELSE 106 ! ! Other configurations: Initial temperature and salinityfields105 ! ! Other configurations: Initial T-S fields 107 106 #if defined key_dtatem 108 107 CALL dta_tem( nit000 ) ! read 3D temperature data 109 tb(:,:,:) = t_dta(:,:,:) ! use temperature data read110 tn(:,:,:) = t_dta(:,:,:)108 tb(:,:,:) = t_dta(:,:,:) ; tn(:,:,:) = t_dta(:,:,:) 109 111 110 #else 112 111 IF(lwp) WRITE(numout,*) ! analytical temperature profile … … 116 115 #if defined key_dtasal 117 116 CALL dta_sal( nit000 ) ! read 3D salinity data 118 sb(:,:,:) = s_dta(:,:,:) ! use salinity data read 119 sn(:,:,:) = s_dta(:,:,:) 117 sb(:,:,:) = s_dta(:,:,:) ; sn(:,:,:) = s_dta(:,:,:) 120 118 #else 121 119 ! No salinity data … … 125 123 #endif 126 124 ENDIF 127 128 CALL tra_swap ! swap 3D arrays (t a,sa) in a 4D array125 ! 126 CALL tra_swap ! swap 3D arrays (tb,sb,tn,sn) in a 4D array 129 127 CALL eos( tsb, rhd, rhop ) ! before potential and in situ densities 130 IF( ln_zps .AND. .NOT. lk_c1d ) & 131 CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 132 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 133 128 IF( ln_zps .AND. .NOT. lk_c1d ) CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! zps: before hor. gradient 129 & rhd, gru , grv ) ! of t,s,rd at ocean bottom 130 ! 134 131 ENDIF 135 132 ! 136 IF( lk_agrif ) THEN 137 ! read free surface arrays in restart file 133 IF( lk_agrif ) THEN ! read free surface arrays in restart file 138 134 IF( ln_rstart ) THEN 139 135 IF( lk_dynspg_flt ) CALL flt_rst( nit000, 'READ' ) ! read or initialize the following fields … … 162 158 IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile' 163 159 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 164 160 ! 165 161 DO jk = 1, jpk 166 162 DO jj = 1, jpj … … 173 169 END DO 174 170 END DO 175 171 ! 176 172 IF(lwp) CALL prizre( tn , jpi , jpj , jpk , jpj/2 , & 177 173 & 1 , jpi , 5 , 1 , jpk , & … … 193 189 REAL(wp) :: zsal = 35.50_wp 194 190 !!---------------------------------------------------------------------- 195 191 ! 196 192 IF(lwp) WRITE(numout,*) 197 193 IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal 198 194 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 199 195 ! 200 196 sn(:,:,:) = zsal * tmask(:,:,:) 201 197 sb(:,:,:) = sn(:,:,:) 202 198 ! 203 199 END SUBROUTINE istate_sal 204 200 … … 216 212 !! and relative vorticity fields 217 213 !!---------------------------------------------------------------------- 218 USE eosbn2 ! eq. of state, Brunt Vaisala frequency (eos routine)219 214 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) 220 215 USE iom … … 224 219 INTEGER :: ijloc 225 220 REAL(wp) :: zh1, zh2, zslope, zcst, zfcor ! temporary scalars 226 REAL(wp) :: zt1 = 15._wp , &! surface temperature value (EEL R5)227 & zt2 = 5._wp, &! bottom temperature value (EEL R5)228 & zsal = 35.0_wp, &! constant salinity (EEL R2, R5 and R6)229 &zueel = 0.1_wp ! constant uniform zonal velocity (EEL R5)221 REAL(wp) :: zt1 = 15._wp ! surface temperature value (EEL R5) 222 REAL(wp) :: zt2 = 5._wp ! bottom temperature value (EEL R5) 223 REAL(wp) :: zsal = 35.0_wp ! constant salinity (EEL R2, R5 and R6) 224 REAL(wp) :: zueel = 0.1_wp ! constant uniform zonal velocity (EEL R5) 230 225 REAL(wp), DIMENSION(jpiglo,jpjglo) :: zssh ! initial ssh over the global domain 231 226 !!---------------------------------------------------------------------- … … 235 230 CASE ( 5 ) ! EEL R5 configuration 236 231 ! ! ==================== 237 232 ! 238 233 ! set temperature field with a linear profile 239 234 ! ------------------------------------------- … … 241 236 IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: linear temperature profile' 242 237 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 243 238 ! 244 239 zh1 = gdept_0( 1 ) 245 240 zh2 = gdept_0(jpkm1) 246 241 ! 247 242 zslope = ( zt1 - zt2 ) / ( zh1 - zh2 ) 248 243 zcst = ( zt1 * ( zh1 - zh2) - ( zt1 - zt2 ) * zh1 ) / ( zh1 - zh2 ) 249 244 ! 250 245 DO jk = 1, jpk 251 246 tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 252 247 tb(:,:,jk) = tn(:,:,jk) 253 248 END DO 254 249 ! 255 250 IF(lwp) CALL prizre( tn , jpi , jpj , jpk , jpj/2 , & 256 251 & 1 , jpi , 5 , 1 , jpk , & 257 252 & 1 , 1. , numout ) 258 253 ! 259 254 ! set salinity field to a constant value 260 255 ! -------------------------------------- … … 262 257 IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal 263 258 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 264 259 ! 265 260 sn(:,:,:) = zsal * tmask(:,:,:) 266 261 sb(:,:,:) = sn(:,:,:) 267 268 262 ! 269 263 ! set the dynamics: U,V, hdiv, rot (and ssh if necessary) 270 264 ! ---------------- … … 273 267 ! we assume a uniform grid (hence the use of e1t(1,1) for delta_y) 274 268 ! we use the Coriolis frequency at mid-channel. 275 276 269 ub(:,:,:) = zueel * umask(:,:,:) 277 270 un(:,:,:) = ub(:,:,:) 278 271 ijloc = mj0(INT(jpjglo-1)/2) 279 272 zfcor = ff(1,ijloc) 280 273 ! 281 274 DO jj = 1, jpjglo 282 275 zssh(:,jj) = - (FLOAT(jj)- FLOAT(jpjglo-1)/2.)*zueel*e1t(1,1)*zfcor/grav 283 276 END DO 284 277 ! 285 278 IF(lwp) THEN 286 279 WRITE(numout,*) ' Uniform zonal velocity for EEL R5:',zueel … … 288 281 WRITE(numout,'(12(1x,f6.2))') zssh(1,:) 289 282 ENDIF 290 283 ! 291 284 DO jj = 1, nlcj 292 285 DO ji = 1, nlci … … 296 289 sshb(nlci+1:jpi, : ) = 0.e0 ! set to zero extra mpp columns 297 290 sshb( : ,nlcj+1:jpj) = 0.e0 ! set to zero extra mpp rows 298 291 ! 299 292 sshn(:,:) = sshb(:,:) ! set now ssh to the before value 300 293 ! 301 294 IF( nn_rstssh /= 0 ) THEN 302 nn_rstssh = 0 295 nn_rstssh = 0 ! hand-made initilization of ssh 303 296 CALL ctl_warn( 'istate_eel: force nn_rstssh = 0' ) 304 297 ENDIF 305 306 ! horizontal divergence and relative vorticity (curl) 307 CALL div_cur( nit000 ) 308 298 ! 299 CALL div_cur( nit000 ) ! horizontal divergence and relative vorticity (curl) 309 300 ! N.B. the vertical velocity will be computed from the horizontal divergence field 310 301 ! in istate by a call to wzv routine … … 314 305 CASE ( 2 , 6 ) ! EEL R2 or R6 configuration 315 306 ! ! ========================== 316 307 ! 317 308 ! set temperature field with a NetCDF file 318 309 ! ---------------------------------------- … … 320 311 IF(lwp) WRITE(numout,*) 'istate_eel : EEL R2 or R6: read initial temperature in a NetCDF file' 321 312 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 322 313 ! 323 314 CALL iom_open ( 'eel.initemp', inum ) 324 315 CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb) 325 316 CALL iom_close( inum ) 326 317 ! 327 318 tn(:,:,:) = tb(:,:,:) ! set nox temperature to tb 328 319 ! 329 320 IF(lwp) CALL prizre( tn , jpi , jpj , jpk , jpj/2 , & 330 321 & 1 , jpi , 5 , 1 , jpk , & 331 322 & 1 , 1. , numout ) 332 333 323 ! 334 324 ! set salinity field to a constant value 335 325 ! -------------------------------------- … … 337 327 IF(lwp) WRITE(numout,*) 'istate_eel : EEL R5: constant salinity field, S = ', zsal 338 328 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 339 329 ! 340 330 sn(:,:,:) = zsal * tmask(:,:,:) 341 331 sb(:,:,:) = sn(:,:,:) 342 332 ! 343 333 ! ! =========================== 344 334 CASE DEFAULT ! NONE existing configuration … … 346 336 WRITE(ctmp1,*) 'EEL with a ', jp_cfg,' km resolution is not coded' 347 337 CALL ctl_stop( ctmp1 ) 348 338 ! 349 339 END SELECT 350 340 ! 351 341 END SUBROUTINE istate_eel 352 342 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/oce.F90
r2082 r2104 4 4 !! Ocean : dynamics and active tracers defined in memory 5 5 !!====================================================================== 6 !! History : 0.1 ! 2002-11 (G. Madec) F90: Free form and module 7 !! 1.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization 6 !! History : 1.0 ! 2002-11 (G. Madec) F90: Free form and module 8 7 !! 3.1 ! 2009-02 (G. Madec, M. Leclair) pure z* coordinate 8 !! 3.3 ! 2010-09 (C. Ethe) TRA-TRC merge: add ts, gtsu, gtsv 4D arrays 9 9 !!---------------------------------------------------------------------- 10 10 USE par_oce ! ocean parameters … … 13 13 PRIVATE 14 14 15 LOGICAL, PUBLIC :: l_traldf_rot = .FALSE. !: rotated laplacian operator for lateral diffusion 15 LOGICAL , PUBLIC :: l_traldf_rot = .FALSE. !: rotated laplacian operator for lateral diffusion 16 CHARACTER(len=3), PUBLIC :: l_adv !: flag for the advection scheme used (= 'ce2', 'tvd' ...) 16 17 17 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields 18 !! -------------------------- ! fields ! fields ! trends ! only after tra_zdf and dyn_spg 19 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: ub , un , ua !: i-horizontal velocity [m/s] 20 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: vb , vn , va !: j-horizontal velocity [m/s] 21 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: wn !: vertical velocity [m/s] 22 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rotb , rotn !: relative vorticity [s-1] 23 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: hdivb , hdivn !: horizontal divergence [s-1] 24 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: tb , tn , ta !: potential temperature [Celcius] 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: sb , sn , sa !: salinity [psu] 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 18 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields 19 !! -------------------------- ! fields ! fields ! trends ! only after tra_zdf and dyn_spg 20 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: ub , un , ua !: i-horizontal velocity [m/s] 21 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: vb , vn , va !: j-horizontal velocity [m/s] 22 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: wn !: vertical velocity [m/s] 23 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rotb , rotn !: relative vorticity [s-1] 24 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: hdivb, hdivn !: horizontal divergence [s-1] 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: tb , tn , ta !: potential temperature [Celcius] 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: sb , sn , sa !: salinity [psu] 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpts) :: tsb , tsn , tsa !: 4D T-S fields [Celcius,psu] 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rn2b , rn2 !: brunt-vaisala frequency**2 [s-2] 27 29 ! 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 [no units] 29 31 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rhop !: potential volumic mass [kg/m3] 30 31 !! advection scheme choice32 !! -----------------------33 CHARACTER(len=3), PUBLIC :: l_adv !: flag for the advection scheme used (= 'ce2', 'tvd', 'mus' or ...)34 35 !! surface pressure gradient36 !! -------------------------37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: spgu, spgv !: horizontal surface pressure gradient38 39 !! interpolated gradient (only used in zps case)40 !! ---------------------41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: gtsu, gtsv !: horizontal gradient of T, S bottom u-point42 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gru , grv !: horizontal gradient of rd at bottom u-point43 32 44 33 !! free surface ! before ! now ! after ! … … 48 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshv_b , sshv_n , sshv_a !: sea surface height at u-point [m] 49 38 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshf_b , sshf_n , sshf_a !: sea surface height at f-point [m] 39 ! 40 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: spgu, spgv !: horizontal surface pressure gradient 50 41 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpts) :: tsb, tsn, tsa !: 4D array for T & S 52 ! !: ( tb, sb), (tn, sn ), (ta, sa ) 42 !! interpolated gradient (only used in zps case) 43 !! --------------------- 44 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: gtsu, gtsv !: horizontal gradient of T, S bottom u-point 45 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gru , grv !: horizontal gradient of rd at bottom u-point 53 46 54 47 !!---------------------------------------------------------------------- 55 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2008)48 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 56 49 !! $Id$ 57 50 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/opa.F90
r2082 r2104 7 7 !! 7.0 ! 1991-11 (M. Imbard, C. Levy, G. Madec) 8 8 !! 7.1 ! 1993-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 9 !! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes )release 7.19 !! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 10 10 !! - ! 1992-06 (L.Terray) coupling implementation 11 11 !! - ! 1993-11 (M.A. Filiberti) IGLOO sea-ice 12 12 !! 8.0 ! 1996-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 13 !! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) 13 !! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 14 14 !! 8.1 ! 1997-06 (M. Imbard, G. Madec) 15 15 !! 8.2 ! 1999-11 (M. Imbard, H. Goosse) LIM sea-ice model … … 31 31 !! opa_model : solve ocean dynamics, tracer and/or sea-ice 32 32 !! opa_init : initialization of the opa model 33 !! opa_ flg: initialisation of algorithm flag33 !! opa_ctl : initialisation of algorithm flag 34 34 !! opa_closefile : close remaining files 35 35 !!---------------------------------------------------------------------- … … 72 72 73 73 !!---------------------------------------------------------------------- 74 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)74 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 75 75 !! $Id$ 76 76 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 204 204 WRITE(numout,*) ' NEMO team' 205 205 WRITE(numout,*) ' Ocean General Circulation Model' 206 WRITE(numout,*) ' version 3. 2 (2009) '206 WRITE(numout,*) ' version 3.3 (2010) ' 207 207 WRITE(numout,*) 208 208 WRITE(numout,*) … … 217 217 ! !--------------------------------! 218 218 219 CALL opa_ flg! Control prints & Benchmark219 CALL opa_ctl ! Control prints & Benchmark 220 220 221 221 ! ! Domain decomposition … … 223 223 ELSE ; CALL mpp_init2 ! eliminate land processors 224 224 ENDIF 225 226 227 228 229 225 230 226 ! ! General initialization … … 243 239 244 240 ! ! Ocean physics 245 CALL sbc_init ! Forcings : surface module 246 241 CALL sbc_init ! Forcings : surface module 247 242 ! ! Vertical physics 248 243 CALL zdf_init ! namelist read 249 244 CALL zdf_bfr_init ! bottom friction 250 245 IF( lk_zdfric ) CALL zdf_ric_init ! Richardson number dependent Kz 251 IF( lk_zdftke_old ) CALL zdf_tke_init 252 IF( lk_zdftke ) CALL 246 IF( lk_zdftke_old ) CALL zdf_tke_init_o ! TKE closure scheme for Kz (old scheme) 247 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme for Kz 253 248 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme for Kz 254 249 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing … … 272 267 ! ! Dynamics 273 268 CALL dyn_adv_init ! advection (vector or flux form) 274 CALL 269 CALL dyn_vor_init ! vorticity term including Coriolis 275 270 CALL dyn_ldf_init ! lateral mixing 276 CALL 271 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 277 272 CALL dyn_zdf_init ! vertical diffusion 278 273 CALL dyn_spg_init ! surface pressure gradient … … 291 286 292 287 293 SUBROUTINE opa_ flg288 SUBROUTINE opa_ctl 294 289 !!---------------------------------------------------------------------- 295 290 !! *** ROUTINE opa *** … … 308 303 IF(lwp) THEN ! Parameter print 309 304 WRITE(numout,*) 310 WRITE(numout,*) 'opa_ flg: Control prints & Benchmark'305 WRITE(numout,*) 'opa_ctl: Control prints & Benchmark' 311 306 WRITE(numout,*) '~~~~~~~ ' 312 307 WRITE(numout,*) ' Namelist namctl' … … 377 372 END SELECT 378 373 ENDIF 379 380 REWIND( numnam ) ! Read Namelist namdyn_hpg : ln_dynhpg_imp must be read at the initialisation phase 381 READ ( numnam, namdyn_hpg ) 382 ! 383 END SUBROUTINE opa_flg 374 ! 375 END SUBROUTINE opa_ctl 384 376 385 377 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/par_oce.F90
r2025 r2104 4 4 !! Ocean : set the ocean parameters 5 5 !!====================================================================== 6 !! History : 7 !! 4.0 ! 91 (Imbard, Levy, Madec) Original code 8 !! 9.0 ! 04-01 (G. Madec, J.-M. Molines) Free form and module 9 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization 10 !!---------------------------------------------------------------------- 11 !! OPA 9.0 , LOCEAN-IPSL (2005) 12 !! $Id$ 13 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 14 !!---------------------------------------------------------------------- 15 !! * Modules used 6 !! History : OPA ! 1991 (Imbard, Levy, Madec) Original code 7 !! NEMO 1.0 ! 2004-01 (G. Madec, J.-M. Molines) Free form and module 8 !! 3.3 ! 2010-09 (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal 9 !!---------------------------------------------------------------------- 16 10 USE par_kind ! kind parameters 17 11 … … 22 16 !! Domain decomposition 23 17 !!---------------------------------------------------------------------- 24 !! * if we dont use massively parallel computer (parameters jpni=jpnj=1) 25 !! so jpiglo=jpi and jpjglo=jpj 26 18 !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj 27 19 #if ! defined key_mpp_dyndist 28 INTEGER, PUBLIC, PARAMETER :: & !: 29 jpni = 1, & !: number of processors following i 30 jpnj = 1, & !: number of processors following j 31 jpnij = 1 !: nb of local domain = nb of processors 32 ! ! ( <= jpni x jpnj ) 33 #else 34 INTEGER, PUBLIC :: & ! 35 jpni , & !: number of processors following i 36 jpnj , & !: number of processors following j 37 jpnij !: nb of local domain = nb of processors 38 ! ! ( <= jpni x jpnj ) 39 #endif 40 41 INTEGER, PUBLIC, PARAMETER :: & !: 42 jpr2di = 0, & !: number of columns for extra outer halo 43 jpr2dj = 0, & !: number of rows for extra outer halo 44 jpreci = 1, & !: number of columns for overlap 45 jprecj = 1 !: number of rows for overlap 20 INTEGER, PUBLIC, PARAMETER :: jpni = 1 !: number of processors following i 21 INTEGER, PUBLIC, PARAMETER :: jpnj = 1 !: number of processors following j 22 INTEGER, PUBLIC, PARAMETER :: jpnij = 1 !: nb of local domain = nb of processors ( <= jpni x jpnj ) 23 #else 24 INTEGER, PUBLIC :: jpni !: number of processors following i 25 INTEGER, PUBLIC :: jpnj !: number of processors following j 26 INTEGER, PUBLIC :: jpnij !: nb of local domain = nb of processors ( <= jpni x jpnj ) 27 #endif 28 INTEGER, PUBLIC, PARAMETER :: jpr2di = 0 !: number of columns for extra outer halo 29 INTEGER, PUBLIC, PARAMETER :: jpr2dj = 0 !: number of rows for extra outer halo 30 INTEGER, PUBLIC, PARAMETER :: jpreci = 1 !: number of columns for overlap 31 INTEGER, PUBLIC, PARAMETER :: jprecj = 1 !: number of rows for overlap 46 32 47 33 !! Ocean Domain sizes … … 100 86 !! default option : small closed basin 101 87 !!--------------------------------------------------------------------- 102 CHARACTER(len=16), PUBLIC, PARAMETER :: & !: 103 cp_cfg = "default" !: name of the configuration 104 INTEGER, PARAMETER :: & !: 105 jp_cfg = 0 , & !: resolution of the configuration 106 107 ! data size !!! * size of all input files * 108 jpidta = 10, & !: 1st lateral dimension ( >= jpi ) 109 jpjdta = 12, & !: 2nd " " ( >= jpj ) 110 jpkdta = 31, & !: number of levels ( >= jpk ) 111 112 ! global or zoom domain size !!! * computational domain * 113 jpiglo = jpidta, & !: 1st dimension of global domain --> i 114 jpjglo = jpjdta, & !: 2nd " " --> j 115 jpk = jpkdta, & !: number of vertical levels 116 ! zoom starting position 117 jpizoom = 1 , & !: left bottom (i,j) indices of the zoom 118 jpjzoom = 1 , & !: in data domain indices 119 120 ! Domain characteristics 121 jperio = 0 !: lateral cond. type (between 0 and 6) 122 ! ! = 0 closed 123 ! ! = 1 cyclic East-West 124 ! ! = 2 equatorial symmetric 125 ! ! = 3 North fold T-point pivot 126 ! ! = 4 cyclic East-West AND North fold T-point pivot 127 ! ! = 5 North fold F-point pivot 128 ! ! = 6 cyclic East-West AND North fold F-point pivot 129 130 !! Values set to pp_not_used indicates that this parameter is not used in THIS config. 131 !! Values set to pp_to_be_computed indicates that variables will be computed in domzgr 132 REAL(wp), PARAMETER :: & !: 133 pp_not_used = 999999._wp , & !: 134 pp_to_be_computed = 999999._wp !: 88 CHARACTER(len=16), PUBLIC, PARAMETER :: cp_cfg = "default" !: name of the configuration 89 INTEGER , PUBLIC, PARAMETER :: jp_cfg = 0 !: resolution of the configuration 90 91 ! data size !!! * size of all input files * 92 INTEGER, PUBLIC, PARAMETER :: jpidta = 10 !: 1st lateral dimension ( >= jpi ) 93 INTEGER, PUBLIC, PARAMETER :: jpjdta = 12 !: 2nd " " ( >= jpj ) 94 INTEGER, PUBLIC, PARAMETER :: jpkdta = 31 !: number of levels ( >= jpk ) 95 96 ! global or zoom domain size !!! * computational domain * 97 INTEGER, PUBLIC, PARAMETER :: jpiglo = jpidta !: 1st dimension of global domain --> i 98 INTEGER, PUBLIC, PARAMETER :: jpjglo = jpjdta !: 2nd - - --> j 99 INTEGER, PUBLIC, PARAMETER :: jpk = jpkdta !: number of vertical levels 100 ! zoom starting position 101 INTEGER, PUBLIC, PARAMETER :: jpizoom = 1 !: left bottom (i,j) indices of the zoom 102 INTEGER, PUBLIC, PARAMETER :: jpjzoom = 1 !: in data domain indices 103 104 ! Domain characteristics 105 INTEGER, PUBLIC, PARAMETER :: jperio = 0 !: lateral cond. type (between 0 and 6) 106 ! ! = 0 closed ; = 1 cyclic East-West 107 ! ! = 2 equatorial symmetric ; = 3 North fold T-point pivot 108 ! ! = 4 cyclic East-West AND North fold T-point pivot 109 ! ! = 5 North fold F-point pivot 110 ! ! = 6 cyclic East-West AND North fold F-point pivot 111 112 !! Values set to pp_not_used indicates that this parameter is not used in THIS config. 113 !! Values set to pp_to_be_computed indicates that variables will be computed in domzgr 114 REAL(wp), PUBLIC, PARAMETER :: pp_not_used = 999999._wp !: vertical grid parameter 115 REAL(wp), PUBLIC, PARAMETER :: pp_to_be_computed = 999999._wp !: - - - 135 116 136 117 137 118 !! Horizontal grid parameters for domhgr 138 119 !! ===================================== 139 140 INTEGER, PUBLIC, PARAMETER :: & !: 141 jphgr_msh = 0 !: type of horizontal mesh 142 ! ! = 0 curvilinear coordinate on the sphere 143 ! ! read in coordinate.nc file 144 ! ! = 1 geographical mesh on the sphere 145 ! ! with regular grid-spacing 146 ! ! = 2 f-plane with regular grid-spacing 147 ! ! = 3 beta-plane with regular grid-spacing 148 ! ! = 4 Mercator grid with T/U point at the equator with 149 ! ! isotropic resolution (e1_deg) 150 151 REAL(wp) , PUBLIC, PARAMETER :: & !: 152 ppglam0 = 0.0_wp, & !: longitude of first raw and column T-point (jphgr_msh = 1) 153 ppgphi0 = -35.0_wp, & !: latitude of first raw and column T-point (jphgr_msh = 1) 154 ! ! latitude for the Coriolis or Beta parameter (jphgr_msh = 2 or 3) 155 ppe1_deg = 1.0_wp, & !: zonal grid-spacing (degrees) 156 ppe2_deg = 0.5_wp, & !: meridional grid-spacing (degrees) 157 ppe1_m = 5000.0_wp, & !: zonal grid-spacing (degrees) 158 ppe2_m = 5000.0_wp !: meridional grid-spacing (degrees) 120 INTEGER, PUBLIC, PARAMETER :: jphgr_msh = 0 !: type of horizontal mesh 121 ! ! = 0 curvilinear coordinate on the sphere read in coordinate.nc 122 ! ! = 1 geographical mesh on the sphere with regular grid-spacing 123 ! ! = 2 f-plane with regular grid-spacing 124 ! ! = 3 beta-plane with regular grid-spacing 125 ! ! = 4 Mercator grid with T/U point at the equator 126 127 REAL(wp) , PUBLIC, PARAMETER :: ppglam0 = 0.0_wp !: longitude of first raw and column T-point (jphgr_msh = 1) 128 REAL(wp) , PUBLIC, PARAMETER :: ppgphi0 = -35.0_wp !: latitude of first raw and column T-point (jphgr_msh = 1) 129 ! ! used for Coriolis & Beta parameters (jphgr_msh = 2 or 3) 130 REAL(wp) , PUBLIC, PARAMETER :: ppe1_deg = 1.0_wp !: zonal grid-spacing (degrees) 131 REAL(wp) , PUBLIC, PARAMETER :: ppe2_deg = 0.5_wp !: meridional grid-spacing (degrees) 132 REAL(wp) , PUBLIC, PARAMETER :: ppe1_m = 5000.0_wp !: zonal grid-spacing (degrees) 133 REAL(wp) , PUBLIC, PARAMETER :: ppe2_m = 5000.0_wp !: meridional grid-spacing (degrees) 159 134 160 135 !! Vertical grid parameter for domzgr 161 136 !! ================================== 162 163 REAL(wp), PUBLIC, PARAMETER :: & !: 164 & ppsur = -4762.96143546300_wp , & !: ORCA r4, r2 and r05 coefficients 165 & ppa0 = 255.58049070440_wp , & !: (default coefficients) 166 & ppa1 = 245.58132232490_wp , & !: 167 & ppkth = 21.43336197938_wp , & !: 168 & ppacr = 3.00000000000_wp !: 169 170 !! If both ppa0 ppa1 and ppsur are specified to 0, then 171 !! they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 172 173 REAL(wp), PUBLIC, PARAMETER :: & !: 174 & ppdzmin = 10._wp , & !: Minimum vertical spacing 175 & pphmax = 5000._wp !: Maximum depth 176 177 !!--------------------------------------------------------------------- 178 #endif 179 180 INTEGER, PUBLIC, PARAMETER :: jpts = 2 !: Number of active tracers ( T & S ) 181 INTEGER, PUBLIC, PARAMETER :: jp_tem = 1 !: indice for temperature 182 INTEGER, PUBLIC, PARAMETER :: jp_sal = 2 !: indice for salinity 183 184 !!--------------------------------------------------------------------- 185 !! Domain Matrix size 186 !!--------------------------------------------------------------------- 187 INTEGER & !: 188 #if !defined key_agrif 189 ,PARAMETER & 190 #endif 191 :: & 192 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci , & !: first dimension 193 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj , & !: second dimension 194 jpim1 = jpi-1, & !: inner domain indices 195 jpjm1 = jpj-1, & !: " " 196 jpkm1 = jpk-1, & !: " " 197 jpij = jpi*jpj !: jpi x jpj 198 137 REAL(wp), PUBLIC, PARAMETER :: ppsur = -4762.96143546300_wp !: ORCA r4, r2 and r05 coefficients 138 REAL(wp), PUBLIC, PARAMETER :: ppa0 = 255.58049070440_wp !: (default coefficients) 139 REAL(wp), PUBLIC, PARAMETER :: ppa1 = 245.58132232490_wp !: 140 REAL(wp), PUBLIC, PARAMETER :: ppkth = 21.43336197938_wp !: 141 REAL(wp), PUBLIC, PARAMETER :: ppacr = 3.00000000000_wp !: 142 ! 143 ! If both ppa0 ppa1 and ppsur are specified to 0, then 144 ! they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr 145 REAL(wp), PUBLIC, PARAMETER :: ppdzmin = 10._wp !: Minimum vertical spacing 146 REAL(wp), PUBLIC, PARAMETER :: pphmax = 5000._wp !: Maximum depth 147 148 #endif 149 150 151 !!--------------------------------------------------------------------- 152 !! Active tracer parameters 153 !!--------------------------------------------------------------------- 154 INTEGER, PUBLIC, PARAMETER :: jpts = 2 !: Number of active tracers (=2, i.e. T & S ) 155 INTEGER, PUBLIC, PARAMETER :: jp_tem = 1 !: indice for temperature 156 INTEGER, PUBLIC, PARAMETER :: jp_sal = 2 !: indice for salinity 157 158 !!--------------------------------------------------------------------- 159 !! Domain Matrix size (if AGRIF, they are not all parameters) 160 !!--------------------------------------------------------------------- 199 161 #if defined key_agrif 200 !!--------------------------------------------------------------------- 201 !! Agrif variables 202 !!--------------------------------------------------------------------- 203 INTEGER, PUBLIC, PARAMETER :: nbghostcells = 1 204 INTEGER, PUBLIC :: nbcellsx = jpiglo - 2 - 2*nbghostcells 205 INTEGER, PUBLIC :: nbcellsy = jpjglo - 2 - 2*nbghostcells 206 #endif 162 INTEGER, PUBLIC, PARAMETER :: nbghostcells = 1 !: number of ghost cells 163 INTEGER, PUBLIC :: nbcellsx = jpiglo - 2 - 2*nbghostcells !: number of cells in i-direction 164 INTEGER, PUBLIC :: nbcellsy = jpjglo - 2 - 2*nbghostcells !: number of cells in j-direction 165 ! 166 INTEGER, PUBLIC :: jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci !: first dimension 167 INTEGER, PUBLIC :: jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dimension 168 INTEGER, PUBLIC :: jpim1 = jpi-1 !: inner domain indices 169 INTEGER, PUBLIC :: jpjm1 = jpj-1 !: - - - 170 INTEGER, PUBLIC :: jpkm1 = jpk-1 !: - - - 171 INTEGER, PUBLIC :: jpij = jpi*jpj !: jpi x jpj 172 #else 173 INTEGER, PUBLIC, PARAMETER :: jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci !: first dimension 174 INTEGER, PUBLIC, PARAMETER :: jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj !: second dimension 175 INTEGER, PUBLIC, PARAMETER :: jpim1 = jpi-1 !: inner domain indices 176 INTEGER, PUBLIC, PARAMETER :: jpjm1 = jpj-1 !: - - - 177 INTEGER, PUBLIC, PARAMETER :: jpkm1 = jpk-1 !: - - - 178 INTEGER, PUBLIC, PARAMETER :: jpij = jpi*jpj !: jpi x jpj 179 #endif 180 207 181 !!--------------------------------------------------------------------- 208 182 !! Optimization/control flags … … 214 188 #endif 215 189 216 #if defined key_vectopt_memory217 LOGICAL, PUBLIC, PARAMETER :: lk_vopt_mem = .TRUE. !: vector optimization flag218 #else219 LOGICAL, PUBLIC, PARAMETER :: lk_vopt_mem = .FALSE. !: vector optimization flag220 #endif221 222 190 #if defined key_vectopt_loop 223 191 LOGICAL, PUBLIC, PARAMETER :: lk_vopt_loop = .TRUE. !: vector optimization flag … … 226 194 #endif 227 195 196 !!---------------------------------------------------------------------- 197 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 198 !! $Id$ 199 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 228 200 !!====================================================================== 229 201 END MODULE par_oce -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/step.F90
r2082 r2104 21 21 !! 3.2 ! 2009-02 (G. Madec, R. Benshila) reintroduicing z*-coordinate 22 22 !! - ! 2009-06 (S. Masson, G. Madec) TKE restart compatible with key_cpl 23 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 23 24 !!---------------------------------------------------------------------- 24 25 … … 27 28 !!---------------------------------------------------------------------- 28 29 USE step_oce ! time stepping definition modules 30 #if defined key_top 31 USE trcstp ! passive tracer time-stepping (trc_stp routine) 32 #endif 29 33 30 34 IMPLICIT NONE … … 37 41 # include "zdfddm_substitute.h90" 38 42 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)43 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 40 44 !! $Id$ 41 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 73 77 #if defined key_agrif 74 78 kstp = nit000 + Agrif_Nb_Step() 75 ! IF( Agrif_Root() .and. lwp) Write(*,*) '---'76 ! IF(lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp77 79 # if defined key_iomput 78 IF( Agrif_Nbstepint() == 0 )CALL iom_swap80 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap 79 81 # endif 80 82 #endif 81 indic = 1 ! reset to no error condition 82 83 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 84 85 CALL iom_setkt( kstp ) ! say to iom that we are at time step kstp 86 87 CALL rst_opn( kstp ) ! Open the restart file 83 indic = 0 ! reset to no error condition 84 IF( kstp /= nit000 ) CALL day ( kstp ) ! Calendar (day was already called at nit000 in day_init) 85 CALL iom_setkt( kstp ) ! say to iom that we are at time step kstp 86 CALL rst_opn ( kstp ) ! Open the restart file 88 87 89 88 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 190 189 CALL tra_nxt ( kstp ) ! tracer fields at next time step 191 190 CALL eos( tsa, rhd, rhop ) ! Time-filtered in situ density for hpg computation 192 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps: time filtered hor. derivative191 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv, & ! zps: time filtered hor. derivative 193 192 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 194 193 195 194 ELSE ! centered hpg (eos then time stepping) 196 195 CALL eos( tsn, rhd, rhop ) ! now in situ density for hpg computation 197 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: now hor. derivative196 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! zps: now hor. derivative 198 197 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 199 198 IF( ln_zdfnpc ) CALL tra_npc ( kstp ) ! update after fields by non-penetrative convection … … 217 216 CALL dyn_bfr( kstp ) ! bottom friction 218 217 CALL dyn_zdf( kstp ) ! vertical diffusion 219 indic=0220 218 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 221 219 CALL dyn_nxt( kstp ) ! lateral velocity at next time step -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/step_oce.F90
r2082 r2104 2 2 !!====================================================================== 3 3 !! *** MODULE step_oce *** 4 !! Time-stepping : m anager of the ocean, tracer and icetime stepping5 !! ----------------------------------------------------------------------6 USE oce ! ocean dynamics and tracers variables7 USE dom_oce ! ocean space and time domain variables8 USE zdf_oce ! ocean vertical physics variables9 USE ldftra_oce ! ocean tracer - trends10 USE ldfdyn_oce ! ocean dynamics - trends11 USE in_out_manager ! I/O manager12 USE iom !4 !! Time-stepping : module used for the ocean time stepping 5 !!====================================================================== 6 USE oce ! ocean dynamics and tracers variables 7 USE dom_oce ! ocean space and time domain variables 8 USE zdf_oce ! ocean vertical physics variables 9 USE ldftra_oce ! ocean tracer - trends 10 USE ldfdyn_oce ! ocean dynamics - trends 11 USE in_out_manager ! I/O manager 12 USE iom ! 13 13 USE lbclnk 14 14 15 USE daymod ! calendar (day routine)15 USE daymod ! calendar (day routine) 16 16 17 USE dtatem ! ocean temperature data (dta_tem routine)18 USE dtasal ! ocean salinity data (dta_sal routine)19 USE sbcmod ! surface boundary condition (sbc routine)20 USE sbcrnf ! surface boundary condition: runoff variables21 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step)17 USE dtatem ! ocean temperature data (dta_tem routine) 18 USE dtasal ! ocean salinity data (dta_sal routine) 19 USE sbcmod ! surface boundary condition (sbc routine) 20 USE sbcrnf ! surface boundary condition: runoff variables 21 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step) 22 22 USE cpl_oasis3, ONLY : lk_cpl 23 23 24 #if defined key_top 25 USE trcstp ! passive tracer time-stepping (trc_stp routine) 26 #endif 24 USE traqsr ! solar radiation penetration (tra_qsr routine) 25 USE trasbc ! surface boundary condition (tra_sbc routine) 26 USE trabbc ! bottom boundary condition (tra_bbc routine) 27 USE trabbl ! bottom boundary layer (tra_bbl routine) 28 USE tradmp ! internal damping (tra_dmp routine) 29 USE traadv ! advection scheme control (tra_adv_ctl routine) 30 USE traldf ! lateral mixing (tra_ldf routine) 31 USE cla ! cross land advection (tra_cla routine) 32 ! zdfkpp ! KPP non-local tracer fluxes (tra_kpp routine) 33 USE trazdf ! vertical mixing (tra_zdf routine) 34 USE tranxt ! time-stepping (tra_nxt routine) 35 USE tranpc ! non-penetrative convection (tra_npc routine) 27 36 28 USE traqsr ! solar radiation penetration (tra_qsr routine) 29 USE trasbc ! surface boundary condition (tra_sbc routine) 30 USE trabbc ! bottom boundary condition (tra_bbc routine) 31 USE trabbl ! bottom boundary layer (tra_bbl routine) 32 USE tradmp ! internal damping (tra_dmp routine) 33 USE traadv ! advection scheme control (tra_adv_ctl routine) 34 USE traldf ! lateral mixing (tra_ldf routine) 35 USE cla ! cross land advection (tra_cla routine) 36 ! zdfkpp ! KPP non-local tracer fluxes (tra_kpp routine) 37 USE trazdf ! vertical mixing (tra_zdf routine) 38 USE tranxt ! time-stepping (tra_nxt routine) 39 USE tranpc ! non-penetrative convection (tra_npc routine) 37 USE eosbn2 ! equation of state (eos_bn2 routine) 40 38 41 USE eosbn2 ! equation of state (eos_bn2 routine) 39 USE dynadv ! advection (dyn_adv routine) 40 USE dynbfr ! Bottom friction terms (dyn_bfr routine) 41 USE dynvor ! vorticity term (dyn_vor routine) 42 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine) 43 USE dynldf ! lateral momentum diffusion (dyn_ldf routine) 44 USE dynzdf ! vertical diffusion (dyn_zdf routine) 45 USE dynspg_oce ! surface pressure gradient (dyn_spg routine) 46 USE dynspg ! surface pressure gradient (dyn_spg routine) 47 USE dynnxt ! time-stepping (dyn_nxt routine) 42 48 43 USE dynadv ! advection (dyn_adv routine) 44 USE dynbfr ! Bottom friction terms (dyn_bfr routine) 45 USE dynvor ! vorticity term (dyn_vor routine) 46 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine) 47 USE dynldf ! lateral momentum diffusion (dyn_ldf routine) 48 USE dynzdf ! vertical diffusion (dyn_zdf routine) 49 USE dynspg_oce ! surface pressure gradient (dyn_spg routine) 50 USE dynspg ! surface pressure gradient (dyn_spg routine) 51 USE dynnxt ! time-stepping (dyn_nxt routine) 49 USE obc_par ! open boundary condition variables 50 USE obcdta ! open boundary condition data (obc_dta routine) 51 USE obcrst ! open boundary cond. restart (obc_rst routine) 52 USE obcrad ! open boundary cond. radiation (obc_rad routine) 52 53 53 USE obc_par ! open boundary condition variables 54 USE obcdta ! open boundary condition data (obc_dta routine) 55 USE obcrst ! open boundary cond. restart (obc_rst routine) 56 USE obcrad ! open boundary cond. radiation (obc_rad routine) 54 USE bdy_par ! unstructured open boundary data variables 55 USE bdydta ! unstructured open boundary data (bdy_dta routine) 57 56 58 USE bdy_par ! unstructured open boundary data variables 59 USE bdydta ! unstructured open boundary data (bdy_dta routine) 57 USE sshwzv ! vertical velocity and ssh (ssh_wzv routine) 60 58 61 USE sshwzv ! vertical velocity and ssh (ssh_wzv routine) 59 USE ldfslp ! iso-neutral slopes (ldf_slp routine) 60 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine) 62 61 63 USE ldfslp ! iso-neutral slopes (ldf_slp routine) 64 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine) 62 USE zdftmx ! tide-induced vertical mixing (zdf_tmx routine) 63 USE zdfbfr ! bottom friction (zdf_bfr routine) 64 USE zdftke_old ! old TKE vertical mixing (zdf_tke_old routine) 65 USE zdftke ! TKE vertical mixing (zdf_tke routine) 66 USE zdfkpp ! KPP vertical mixing (zdf_kpp routine) 67 USE zdfddm ! double diffusion mixing (zdf_ddm routine) 68 USE zdfevd ! enhanced vertical diffusion (zdf_evd routine) 69 USE zdfric ! Richardson vertical mixing (zdf_ric routine) 70 USE zdfmxl ! Mixed-layer depth (zdf_mxl routine) 65 71 66 USE zdftmx ! tide-induced vertical mixing (zdf_tmx routine) 67 USE zdfbfr ! bottom friction (zdf_bfr routine) 68 USE zdftke_old ! old TKE vertical mixing (zdf_tke_old routine) 69 USE zdftke ! TKE vertical mixing (zdf_tke routine) 70 USE zdfkpp ! KPP vertical mixing (zdf_kpp routine) 71 USE zdfddm ! double diffusion mixing (zdf_ddm routine) 72 USE zdfevd ! enhanced vertical diffusion (zdf_evd routine) 73 USE zdfric ! Richardson vertical mixing (zdf_ric routine) 74 USE zdfmxl ! Mixed-layer depth (zdf_mxl routine) 72 USE zpshde ! partial step: hor. derivative (zps_hde routine) 75 73 76 USE zpshde ! partial step: hor. derivative (zps_hde routine) 74 USE diawri ! Standard run outputs (dia_wri routine) 75 USE trdicp ! Ocean momentum/tracers trends (trd_wri routine) 76 USE trdmld ! mixed-layer trends (trd_mld routine) 77 USE trdmld_rst ! restart for mixed-layer trends 78 USE trdmod_oce ! ocean momentum/tracers trends 79 USE trdmod ! momentum/tracers trends 80 USE trdvor ! vorticity budget (trd_vor routine) 81 USE diagap ! hor. mean model-data gap (dia_gap routine) 82 USE diahdy ! dynamic height (dia_hdy routine) 83 USE diaptr ! poleward transports (dia_ptr routine) 84 USE diaar5 ! AR5 diagnosics (dia_ar5 routine) 85 USE diahth ! thermocline depth (dia_hth routine) 86 USE diafwb ! freshwater budget (dia_fwb routine) 87 USE flo_oce ! floats variables 88 USE floats ! floats computation (flo_stp routine) 77 89 78 USE diawri ! Standard run outputs (dia_wri routine) 79 USE trdicp ! Ocean momentum/tracers trends (trd_wri routine) 80 USE trdmld ! mixed-layer trends (trd_mld routine) 81 USE trdmld_rst ! restart for mixed-layer trends 82 USE trdmod_oce ! ocean momentum/tracers trends 83 USE trdmod ! momentum/tracers trends 84 USE trdvor ! vorticity budget (trd_vor routine) 85 USE diagap ! hor. mean model-data gap (dia_gap routine) 86 USE diahdy ! dynamic height (dia_hdy routine) 87 USE diaptr ! poleward transports (dia_ptr routine) 88 USE diaar5 ! AR5 diagnosics (dia_ar5 routine) 89 USE diahth ! thermocline depth (dia_hth routine) 90 USE diafwb ! freshwater budget (dia_fwb routine) 91 USE flo_oce ! floats variables 92 USE floats ! floats computation (flo_stp routine) 90 USE stpctl ! time stepping control (stp_ctl routine) 91 USE restart ! ocean restart (rst_wri routine) 92 USE prtctl ! Print control (prt_ctl routine) 93 93 94 USE stpctl ! time stepping control (stp_ctl routine) 95 USE restart ! ocean restart (rst_wri routine) 96 USE prtctl ! Print control (prt_ctl routine) 97 98 USE traswp ! Swap arrays (tra_swp routine) 99 ! (tra_unswp routine) 94 USE traswp ! Swap arrays (tra_swp, tra_unswp routine) 100 95 101 96 #if defined key_agrif 102 97 USE agrif_opa_sponge ! Momemtum and tracers sponges 103 98 #endif 104 105 99 !!====================================================================== 106 100 END MODULE step_oce -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/trc_oce.F90
r2082 r2104 21 21 PUBLIC trc_oce_ext_lev ! function called by traqsr.F90 at least 22 22 23 INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers24 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model25 26 23 REAL(wp), PUBLIC , DIMENSION(jpi,jpj,jpk) :: etot3 !: light absortion coefficient 27 24 … … 41 38 # include "domzgr_substitute.h90" 42 39 !!---------------------------------------------------------------------- 43 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)40 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 44 41 !! $Id$ 45 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcini_c14b.F90
r2038 r2104 179 179 ! Check number of tracers 180 180 ! ----------------------- 181 IF( jp_c14b > 1) THEN 182 IF(lwp) THEN 183 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 184 WRITE (numout,*) ' ======= ============= ' 185 WRITE (numout,*) & 186 & ' STOP, change jp_c14b to 1 in par_C14b module ' 187 END IF 188 STOP 'TRC_CTL' 189 END IF 181 IF( jp_c14b > 1) CALL ctl_stop( ' Change jp_c14b to be equal 1 in par_c14b.F90' ) 190 182 191 183 ! Check tracer names … … 197 189 198 190 IF(lwp) THEN 199 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 200 WRITE (numout,*) ' ======= ============= ' 201 WRITE (numout,*) ' we force tracer names' 191 CALL ctl_warn( ' we force tracer names' ) 202 192 WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14) 203 193 WRITE(numout,*) ' ' … … 209 199 ctrcun(jpc14) = 'ration' 210 200 IF(lwp) THEN 211 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 212 WRITE (numout,*) ' ======= ============= ' 213 WRITE (numout,*) ' we force tracer unit' 201 CALL ctl_warn( ' we force tracer unit' ) 214 202 WRITE(numout,*) ' tracer ',ctrcnm(jpc14), 'UNIT= ',ctrcun(jpc14) 215 203 WRITE(numout,*) ' ' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcrst_c14b.F90
r1953 r2104 43 43 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 44 44 45 DO jn = jp_c14b0, jp_c14b1 46 CALL iom_get( knum, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) ) 47 END DO 45 CALL iom_get( knum, jpdom_autoglo, 'qint_c14', qint_c14 ) 48 46 49 47 END SUBROUTINE trc_rst_read_c14b … … 59 57 INTEGER, INTENT(in) :: kitrst ! time step of restart write 60 58 INTEGER, INTENT(in) :: knum ! unit of the restart file 61 INTEGER :: jn ! dummy loop indices62 59 !!---------------------------------------------------------------------- 63 60 … … 66 63 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 67 64 68 DO jn = jp_c14b0, jp_c14b1 69 CALL iom_rstput( kt, kitrst, kum, 'qint_'//ctrcnm(jn), qint_c14(:,:,jn) ) 70 END DO 65 CALL iom_rstput( kt, kitrst, knum, 'qint_c14', qint_c14 ) 71 66 72 67 END SUBROUTINE trc_rst_wri_c14b -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r2082 r2104 131 131 !!---------------------------------------------------------------------- 132 132 133 IF( kt == nit trc000 ) THEN133 IF( kt == nit000 ) THEN 134 134 ! Computation of decay coeffcient 135 135 zdemi = 5730. -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r2082 r2104 93 93 !!---------------------------------------------------------------------- 94 94 95 IF( kt == nit trc000 ) CALL trc_cfc_cst95 IF( kt == nit000 ) CALL trc_cfc_cst 96 96 97 97 ! Temporal interpolation -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r2082 r2104 20 20 USE lbclnk ! 21 21 USE prtctl_trc ! Print control for debbuging 22 USE trdmod_oce 22 23 USE trdmod_trc 23 24 USE iom … … 81 82 !!--------------------------------------------------------------------- 82 83 83 IF( kt == nit trc000 ) THEN84 IF( kt == nit000 ) THEN 84 85 IF(lwp) WRITE(numout,*) 85 86 IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r2082 r2104 19 19 USE lbclnk 20 20 USE trc 21 USE trc trp_lec21 USE trcnam_trp 22 22 USE prtctl_trc ! Print control for debbuging 23 USE trdmod_oce 23 24 USE trdmod_trc 24 25 USE iom … … 60 61 !!--------------------------------------------------------------------- 61 62 62 IF( kt == nit trc000 ) THEN63 IF( kt == nit000 ) THEN 63 64 IF(lwp) WRITE(numout,*) 64 65 IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' … … 125 126 IF( ln_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 126 127 zfact = 2. * rdttra(jk) * FLOAT( nn_dttrc ) 127 IF( neuler == 0 .AND. kt == nit trc000 ) zfact = rdttra(jk) * FLOAT(nn_dttrc)128 IF( neuler == 0 .AND. kt == nit000 ) zfact = rdttra(jk) * FLOAT(nn_dttrc) 128 129 sedpoca(:,:) = sedpocb(:,:) + zfact * sedpoca(:,:) 129 130 ENDIF … … 133 134 ! ------------------------------ 134 135 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ! centred or tvd scheme 135 IF( neuler == 0 .AND. kt == nit trc000 ) THEN136 IF( neuler == 0 .AND. kt == nit000 ) THEN 136 137 DO jj = 1, jpj 137 138 DO ji = 1, jpi -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90
r2038 r2104 275 275 ! Check number of tracers 276 276 ! ----------------------- 277 IF (jp_lobster /= 6) THEN 278 IF (lwp) THEN 279 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 280 WRITE (numout,*) ' ======= ============= ' 281 WRITE (numout,*) & 282 & ' STOP, change jp_lobster to 6 in ' & 283 & ,'par_lobster.F90 ' 284 END IF 285 STOP 'TRC_CTL' 286 END IF 277 IF( jp_lobster /= 6 ) CALL ctl_stop( ' LOBSTER has 6 passive tracers. Change jp_lobster in par_lobster.F90' ) 278 287 279 ! Check tracer names 288 280 ! ------------------ … … 309 301 ctrcnl(jp_lob_dom)='Dissolved organic matter' 310 302 IF(lwp) THEN 311 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 312 WRITE (numout,*) ' ======= ============= ' 313 WRITE (numout,*) ' we force tracer names' 303 CALL ctl_warn( ' We force tracer names ' ) 314 304 DO jl = 1, jp_lobster 315 305 jn = jp_lob0 + jl - 1 … … 326 316 ctrcun(jn) = 'mmole-N/m3' 327 317 IF(lwp) THEN 328 WRITE (numout,*) ' ===>>>> : w a r n i n g ' 329 WRITE (numout,*) ' ======= ============= ' 330 WRITE (numout,*) ' we force tracer unit' 318 CALL ctl_warn( ' We force tracer units ' ) 331 319 WRITE(numout,*) ' tracer ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 332 320 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r2082 r2104 65 65 !!--------------------------------------------------------------------- 66 66 67 IF( kt == nit trc000 ) THEN67 IF( kt == nit000 ) THEN 68 68 IF(lwp) WRITE(numout,*) 69 69 IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r2082 r2104 18 18 USE sms_lobster 19 19 USE lbclnk 20 USE trdmod_oce 20 21 USE trdmod_trc 21 22 USE iom … … 67 68 !!--------------------------------------------------------------------- 68 69 69 IF( kt == nit trc000 ) THEN70 IF( kt == nit000 ) THEN 70 71 IF(lwp) WRITE(numout,*) 71 72 IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90
r2038 r2104 20 20 USE trcexp 21 21 USE trdmod_oce 22 USE trdmod_trc_oce 22 23 USE trdmod_trc 23 24 USE trdmld_trc -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zbio.F90
r1953 r2104 84 84 CALL p4z_sink ( kt, jnt ) ! vertical flux of particulate organic matter 85 85 CALL p4z_opt ( kt, jnt ) ! Optic: PAR in the water column 86 CALL p4z_lim ( kt , jnt) ! co-limitations by the various nutrients86 CALL p4z_lim ( kt ) ! co-limitations by the various nutrients 87 87 CALL p4z_prod ( kt, jnt ) ! phytoplankton growth rate over the global ocean. 88 88 ! ! (for each element : C, Si, Fe, Chl ) 89 CALL p4z_rem ( kt , jnt) ! remineralization terms of organic matter+scavenging of Fe90 CALL p4z_mort ( kt , jnt) ! phytoplankton mortality89 CALL p4z_rem ( kt ) ! remineralization terms of organic matter+scavenging of Fe 90 CALL p4z_mort ( kt ) ! phytoplankton mortality 91 91 ! ! zooplankton sources/sinks routines 92 CALL p4z_micro( kt , jnt) ! microzooplankton92 CALL p4z_micro( kt ) ! microzooplankton 93 93 CALL p4z_meso ( kt, jnt ) ! mesozooplankton 94 94 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zche.F90
r2082 r2104 249 249 & + ( cb8 + cb9 * zsqrt + cb10 * zsal ) * zlogt + cb11 * zsqrt * ztkel & 250 250 & + LOG( ( 1.+ zst / zcks + zft / zckf ) / ( 1.+ zst / zcks ) ) 251 !!gm zsal**2 to be replaced by a *... 252 zck1 = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal **2251 252 zck1 = c10 * ztr + c11 + c12 * zlogt + c13 * zsal + c14 * zsal * zsal 253 253 zck2 = c20 * ztr + c21 + c22 * zsal + c23 * zsal**2 254 254 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zflx.F90
r2082 r2104 33 33 34 34 PUBLIC p4z_flx 35 PUBLIC p4z_flx_init 35 36 36 37 REAL(wp) :: & ! pre-industrial atmospheric [co2] (ppm) … … 81 82 82 83 !!--------------------------------------------------------------------- 83 84 85 IF( kt == nittrc000 ) CALL p4z_flx_init ! Initialization (first time-step only)86 84 87 85 ! SURFACE CHEMISTRY (PCO2 AND [H+] IN … … 246 244 !! 247 245 !! ** Method : Read the nampisext namelist and check the parameters 248 !! called at the first timestep (nit trc000)246 !! called at the first timestep (nit000) 249 247 !! ** input : Namelist nampisext 250 248 !! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zlim.F90
r2082 r2104 23 23 24 24 PUBLIC p4z_lim 25 PUBLIC p4z_lim_init 25 26 26 27 !! * Shared module variables … … 50 51 CONTAINS 51 52 52 SUBROUTINE p4z_lim( kt , jnt)53 SUBROUTINE p4z_lim( kt ) 53 54 !!--------------------------------------------------------------------- 54 55 !! *** ROUTINE p4z_lim *** … … 59 60 !! ** Method : - ??? 60 61 !!--------------------------------------------------------------------- 61 INTEGER, INTENT(in) :: kt, jnt ! ocean time step62 INTEGER, INTENT(in) :: kt 62 63 INTEGER :: ji, jj, jk 63 64 REAL(wp) :: zlim1, zlim2, zlim3, zlim4, zno3, zferlim … … 67 68 68 69 69 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_lim_init ! Initialization (first time-step only) 70 71 72 ! Tuning of the iron concentration to a minimum 73 ! level that is set to the detection limit 74 ! ------------------------------------- 70 ! Tuning of the iron concentration to a minimum 71 ! level that is set to the detection limit 72 ! ------------------------------------- 75 73 76 74 DO jk = 1, jpkm1 … … 85 83 END DO 86 84 87 ! Computation of a variable Ks for iron on diatoms 88 ! taking into account that increasing biomass is 89 ! made of generally bigger cells 90 ! ------------------------------------------------ 85 ! Computation of a variable Ks for iron on diatoms taking into account 86 ! that increasing biomass is made of generally bigger cells 87 ! ------------------------------------------------ 91 88 92 89 DO jk = 1, jpkm1 … … 107 104 END DO 108 105 109 DO jk = 1, jpkm1 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 113 ! Michaelis-Menten Limitation term for nutrients 114 ! Small flagellates 115 ! ----------------------------------------------- 106 ! Michaelis-Menten Limitation term for nutrients Small flagellates 107 ! ----------------------------------------------- 108 DO jk = 1, jpkm1 109 DO jj = 1, jpj 110 DO ji = 1, jpi 116 111 zdenom = 1. / & 117 112 & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) … … 132 127 END DO 133 128 134 DO jk = 1, jpkm1 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 138 ! Michaelis-Menten Limitation term for nutrients Diatoms 139 ! ---------------------------------------------- 129 ! Michaelis-Menten Limitation term for nutrients Diatoms 130 ! ---------------------------------------------- 131 DO jk = 1, jpkm1 132 DO jj = 1, jpj 133 DO ji = 1, jpi 140 134 zdenom = 1. / & 141 135 & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) … … 181 175 !! 182 176 !! ** Method : Read the nampislim namelist and check the parameters 183 !! called at the first timestep (nit trc000)177 !! called at the first timestep (nit000) 184 178 !! 185 179 !! ** input : Namelist nampislim -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zlys.F90
r2038 r2104 27 27 PRIVATE 28 28 29 PUBLIC p4z_lys ! called in p4zprg.F90 29 PUBLIC p4z_lys ! called in trcsms_pisces.F90 30 PUBLIC p4z_lys_init ! called in trcsms_pisces.F90 30 31 31 32 !! * Shared module variables … … 72 73 !!--------------------------------------------------------------------- 73 74 74 IF( kt == nittrc000 ) CALL p4z_lys_init ! Initialization (first time-step only)75 76 75 zco3(:,:,:) = 0. 77 76 … … 197 196 !! 198 197 !! ** Method : Read the nampiscal namelist and check the parameters 199 !! called at the first timestep (nit trc000)198 !! called at the first timestep (nit000) 200 199 !! 201 200 !! ** input : Namelist nampiscal -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmeso.F90
r2038 r2104 26 26 PRIVATE 27 27 28 PUBLIC p4z_meso ! called in p4zbio.F90 28 PUBLIC p4z_meso ! called in p4zbio.F90 29 PUBLIC p4z_meso_init ! called in trcsms_pisces.F90 29 30 30 31 !! * Shared module variables … … 54 55 CONTAINS 55 56 56 SUBROUTINE p4z_meso( kt, jnt )57 SUBROUTINE p4z_meso( kt, jnt ) 57 58 !!--------------------------------------------------------------------- 58 59 !! *** ROUTINE p4z_meso *** … … 65 66 INTEGER :: ji, jj, jk 66 67 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 67 REAL(wp) :: zfact, z step, zcompam, zdenom, zgraze268 REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep 68 69 REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 69 70 #if defined key_kriest 70 71 REAL znumpoc 71 72 #endif 72 REAL(wp) ,DIMENSION(jpi,jpj,jpk):: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof73 REAL(wp) ,DIMENSION(jpi,jpj,jpk):: zgrazn,zgrazpoc,zgraznf,zgrazf74 REAL(wp) ,DIMENSION(jpi,jpj,jpk):: zgrazfff,zgrazffe73 REAL(wp) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 74 REAL(wp) :: zgrazn,zgrazpoc,zgraznf,zgrazf 75 REAL(wp) :: zgrazfff,zgrazffe 75 76 CHARACTER (len=25) :: charout 76 77 #if defined key_diatrc && defined key_iomput … … 80 81 !!--------------------------------------------------------------------- 81 82 82 83 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_meso_init ! Initialization (first time-step only)84 85 zrespz2 (:,:,:) = 0.86 ztortz2 (:,:,:) = 0.87 zgrazd (:,:,:) = 0.88 zgrazz (:,:,:) = 0.89 zgrazpof(:,:,:) = 0.90 zgrazn (:,:,:) = 0.91 zgrazpoc(:,:,:) = 0.92 zgraznf (:,:,:) = 0.93 zgrazf (:,:,:) = 0.94 zgrazfff(:,:,:) = 0.95 zgrazffe(:,:,:) = 0.96 97 zstep = rfact2 / rday ! Time step duration for biology98 99 83 DO jk = 1, jpkm1 100 84 DO jj = 1, jpj … … 103 87 zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 104 88 # if defined key_degrad 105 z fact = zstep * tgfunc(ji,jj,jk) * zcompam* facvol(ji,jj,jk)89 zstep = xstep * facvol(ji,jj,jk) 106 90 # else 91 zstep = xstep 92 # endif 107 93 zfact = zstep * tgfunc(ji,jj,jk) * zcompam 108 # endif 109 110 ! Respiration rates of both zooplankton 111 ! ------------------------------------- 112 zrespz2(ji,jj,jk) = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) ) & 94 95 ! Respiration rates of both zooplankton 96 ! ------------------------------------- 97 zrespz2 = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) ) & 113 98 & * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 114 99 115 ! Zooplankton mortality. A square function has been selected with 116 ! no real reason except that it seems to be more stable and may 117 ! mimic predation. 118 ! --------------------------------------------------------------- 119 ztortz2(ji,jj,jk) = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 100 ! Zooplankton mortality. A square function has been selected with 101 ! no real reason except that it seems to be more stable and may mimic predation 102 ! --------------------------------------------------------------- 103 ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 120 104 ! 121 END DO 122 END DO 123 END DO 124 125 126 DO jk = 1,jpkm1 127 DO jj = 1,jpj 128 DO ji = 1,jpi 105 129 106 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 130 107 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) … … 132 109 zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 133 110 134 !Microzooplankton grazing135 ! ------------------------111 ! Microzooplankton grazing 112 ! ------------------------ 136 113 zdenom = 1. / ( xkgraz2 + xprefc * trn(ji,jj,jk,jpdia) & 137 114 & + xprefz * trn(ji,jj,jk,jpzoo) & … … 139 116 & + xprefpoc * trn(ji,jj,jk,jppoc) ) 140 117 141 zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom & 142 # if defined key_degrad 143 & * facvol(ji,jj,jk) & 118 zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes) 119 120 zgrazd = zgraze2 * xprefc * zcompadi 121 zgrazz = zgraze2 * xprefz * zcompaz 122 zgrazn = zgraze2 * xprefp * zcompaph 123 zgrazpoc = zgraze2 * xprefpoc * zcompapoc 124 125 zgraznf = zgrazn * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 126 zgrazf = zgrazd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 127 zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 128 129 ! Mesozooplankton flux feeding on GOC 130 ! ---------------------------------- 131 # if ! defined key_kriest 132 zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk) & 133 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 134 zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 135 # else 136 !!--------------------------- KRIEST3 ------------------------------------------- 137 !! zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk) & 138 !! & * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) & 139 !! # if defined key_degrad 140 !! & * facvol(ji,jj,jk) & 141 !! # endif 142 !! & / (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 143 !!--------------------------- KRIEST3 ------------------------------------------- 144 145 zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk) & 146 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 147 zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 144 148 # endif 145 & * trn(ji,jj,jk,jpmes)146 147 zgrazd(ji,jj,jk) = zgraze2 * xprefc * zcompadi148 zgrazz(ji,jj,jk) = zgraze2 * xprefz * zcompaz149 zgrazn(ji,jj,jk) = zgraze2 * xprefp * zcompaph150 zgrazpoc(ji,jj,jk) = zgraze2 * xprefpoc * zcompapoc151 152 zgraznf(ji,jj,jk) = zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnfe) &153 & / (trn(ji,jj,jk,jpphy) + rtrn)154 zgrazf(ji,jj,jk) = zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) &155 & / (trn(ji,jj,jk,jpdia) + rtrn)156 zgrazpof(ji,jj,jk) = zgrazpoc(ji,jj,jk) * trn(ji,jj,jk,jpsfe) &157 & / (trn(ji,jj,jk,jppoc) + rtrn)158 END DO159 END DO160 END DO161 162 163 DO jk = 1,jpkm1164 DO jj = 1,jpj165 DO ji = 1,jpi166 167 ! Mesozooplankton flux feeding on GOC168 ! ----------------------------------169 # if ! defined key_kriest170 # if ! defined key_degrad171 zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk) &172 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)173 # else174 zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio4(ji,jj,jk) * facvol(ji,jj,jk) &175 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes)176 # endif177 zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk) &178 & * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)179 # else180 !!--------------------------- KRIEST3 -------------------------------------------181 !! zgrazffe(ji,jj,jk) = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk) &182 !! & * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) &183 # if defined key_degrad184 !! & * facvol(ji,jj,jk) &185 # endif186 !! & / (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1)187 !!--------------------------- KRIEST3 -------------------------------------------188 189 # if ! defined key_degrad190 zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk) &191 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)192 # else193 zgrazffe(ji,jj,jk) = grazflux * zstep * wsbio3(ji,jj,jk) * facvol(ji,jj,jk) &194 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)195 # endif196 197 zgrazfff(ji,jj,jk) = zgrazffe(ji,jj,jk) &198 & * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)199 # endif200 END DO201 END DO202 END DO203 149 204 150 #if defined key_diatrc 205 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 206 grazing(:,:,:) = grazing(:,:,:) + ( zgrazd (:,:,:) + zgrazz (:,:,:) + zgrazn(:,:,:) & 207 & + zgrazpoc(:,:,:) + zgrazffe(:,:,:) ) 208 #endif 209 210 211 DO jk = 1,jpkm1 212 DO jj = 1,jpj 213 DO ji = 1,jpi 214 215 ! Mesozooplankton efficiency 216 ! -------------------------- 217 zgrarem2 = ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 218 & + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) ) & 219 & * ( 1. - epsher2 - unass2 ) 151 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 152 grazing(ji,jj,jk) = grazing(ji,jj,jk) + ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) 153 #endif 154 155 ! Mesozooplankton efficiency 156 ! -------------------------- 157 zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 ) 220 158 #if ! defined key_kriest 221 zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 222 & * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff (ji,jj,jk))*(1.-epsher2-unass2) & 223 & + epsher2 * ( & 224 & zgrazd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 225 & + zgrazn(ji,jj,jk) * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 226 & + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 227 & + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.) ) 159 zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) & 160 & + epsher2 * ( zgrazd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 161 & + zgrazn * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 162 & + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 163 & + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.) ) 228 164 #else 229 zgrafer2 = (zgrazf(ji,jj,jk) + zgraznf(ji,jj,jk) + zgrazz(ji,jj,jk) & 230 & * ferat3 + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) )*(1.-epsher2-unass2) & 231 & + epsher2 * ( & 232 & zgrazd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 233 & + zgrazn(ji,jj,jk) * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 234 & + zgrazpoc(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 235 & + zgrazffe(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) ) 236 237 #endif 238 zgrapoc2 = (zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 239 & + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk)) * unass2 165 zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) & 166 & + epsher2 * ( zgrazd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 167 & + zgrazn * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 168 & + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 169 & + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) ) 170 171 #endif 172 ! Update the arrays TRA which contain the biological sources and sinks 173 174 zgrapoc2 = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe 240 175 241 176 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 242 177 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 243 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1.-sigma2)178 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 ) 244 179 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 245 180 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 … … 247 182 248 183 #if defined key_kriest 249 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 250 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso184 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2 185 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso 251 186 #else 252 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 253 #endif 254 END DO 255 END DO 256 END DO 257 258 DO jk = 1, jpkm1 259 DO jj = 1, jpj 260 DO ji = 1, jpi 261 ! 262 ! Update the arrays TRA which contain the biological sources and sinks 263 ! -------------------------------------------------------------------- 264 zmortz2 = ztortz2(ji,jj,jk) + zrespz2(ji,jj,jk) 265 tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 & 266 & + epsher2 * ( zgrazd(ji,jj,jk) + zgrazz(ji,jj,jk) + zgrazn(ji,jj,jk) & 267 & + zgrazpoc(ji,jj,jk) + zgrazffe(ji,jj,jk) ) 268 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd(ji,jj,jk) 269 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz(ji,jj,jk) 270 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn(ji,jj,jk) 271 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 272 & / ( trn(ji,jj,jk,jpphy) + rtrn ) 273 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 274 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 275 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 276 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 277 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazd(ji,jj,jk) * trn(ji,jj,jk,jpbsi) & 278 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 279 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf(ji,jj,jk) 280 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf(ji,jj,jk) 281 282 zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn(ji,jj,jk) 187 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2 188 #endif 189 zmortz2 = ztortz2 + zrespz2 190 tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2 191 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 192 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 193 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn 194 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trn(ji,jj,jk,jpnch) / ( trn(ji,jj,jk,jpphy) + rtrn ) 195 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 196 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 197 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazd * trn(ji,jj,jk,jpbsi) / ( trn(ji,jj,jk,jpdia) + rtrn ) 198 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf 199 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 200 201 zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn 283 202 #if defined key_diatrc 284 203 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) … … 290 209 #if defined key_kriest 291 210 znumpoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 292 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2 & 293 & - zgrazpoc(ji,jj,jk) - zgrazffe(ji,jj,jk) 294 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc(ji,jj,jk) * znumpoc & 295 & + zmortz2 * xkr_dmeso & 296 & - zgrazffe(ji,jj,jk) * znumpoc * wsbio4(ji,jj,jk) & 297 & / ( wsbio3(ji,jj,jk) + rtrn ) 211 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz2 - zgrazpoc - zgrazffe 212 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 213 & + zmortz2 * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 298 214 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 299 & + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 300 & + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 301 & - zgrazfff(ji,jj,jk) - zgrazpof(ji,jj,jk) 215 & + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof 302 216 #else 303 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc (ji,jj,jk)304 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe (ji,jj,jk)305 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof (ji,jj,jk)217 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 218 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 219 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof 306 220 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 307 & + unass2 * ( ferat3 * zgrazz(ji,jj,jk) + zgraznf(ji,jj,jk) & 308 & + zgrazf(ji,jj,jk) + zgrazpof(ji,jj,jk) + zgrazfff(ji,jj,jk) ) & 309 & - zgrazfff(ji,jj,jk) 221 & + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff 310 222 #endif 311 223 … … 342 254 !! 343 255 !! ** Method : Read the nampismes namelist and check the parameters 344 !! called at the first timestep (nit trc000)256 !! called at the first timestep (nit000) 345 257 !! 346 258 !! ** input : Namelist nampismes … … 373 285 ENDIF 374 286 287 375 288 END SUBROUTINE p4z_meso_init 376 289 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r2038 r2104 26 26 PRIVATE 27 27 28 PUBLIC p4z_micro ! called in p4zbio.F90 28 PUBLIC p4z_micro ! called in p4zbio.F90 29 PUBLIC p4z_micro_init ! called in trcsms_pisces.F90 29 30 30 31 !! * Shared module variables … … 52 53 CONTAINS 53 54 54 SUBROUTINE p4z_micro( kt ,jnt)55 SUBROUTINE p4z_micro( kt ) 55 56 !!--------------------------------------------------------------------- 56 57 !! *** ROUTINE p4z_micro *** … … 60 61 !! ** Method : - ??? 61 62 !!--------------------------------------------------------------------- 62 INTEGER, INTENT(in) :: kt , jnt! ocean time step63 INTEGER, INTENT(in) :: kt ! ocean time step 63 64 INTEGER :: ji, jj, jk 64 65 REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 65 REAL(wp) :: zgraze , zdenom , zdenom2 66 REAL(wp) :: zfact , z step , zinano , zidiat, zipoc66 REAL(wp) :: zgraze , zdenom , zdenom2, zstep 67 REAL(wp) :: zfact , zinano , zidiat, zipoc 67 68 REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 68 REAL(wp) , DIMENSION(jpi,jpj,jpk) :: zrespz,ztortz69 REAL(wp) , DIMENSION(jpi,jpj,jpk):: zgrazp, zgrazm, zgrazsd70 REAL(wp) , DIMENSION(jpi,jpj,jpk):: zgrazmf, zgrazsf, zgrazpf69 REAL(wp) :: zrespz, ztortz 70 REAL(wp) :: zgrazp, zgrazm, zgrazsd 71 REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 71 72 CHARACTER (len=25) :: charout 72 73 73 74 !!--------------------------------------------------------------------- 74 75 75 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_micro_init ! Initialization (first time-step only)76 77 zrespz (:,:,:) = 0.78 ztortz (:,:,:) = 0.79 zgrazp (:,:,:) = 0.80 zgrazm (:,:,:) = 0.81 zgrazsd(:,:,:) = 0.82 zgrazmf(:,:,:) = 0.83 zgrazsf(:,:,:) = 0.84 zgrazpf(:,:,:) = 0.85 76 86 77 #if defined key_diatrc … … 93 84 DO jj = 1, jpj 94 85 DO ji = 1, jpi 95 96 86 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 97 87 # if defined key_degrad 98 z fact = zstep * tgfunc(ji,jj,jk) * zcompaz *facvol(ji,jj,jk)88 zstep = xstep * facvol(ji,jj,jk) 99 89 # else 90 zstep = xstep 91 # endif 100 92 zfact = zstep * tgfunc(ji,jj,jk) * zcompaz 101 # endif 102 103 ! Respiration rates of both zooplankton 104 ! ------------------------------------- 105 106 zrespz(ji,jj,jk) = resrat * zfact * ( 1.+ 3.* nitrfac(ji,jj,jk) ) & 93 94 ! Respiration rates of both zooplankton 95 ! ------------------------------------- 96 zrespz = resrat * zfact * ( 1.+ 3.* nitrfac(ji,jj,jk) ) & 107 97 & * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 108 98 109 ! Zooplankton mortality. A square function has been selected with 110 ! no real reason except that it seems to be more stable and may 111 ! mimic predation. 112 ! --------------------------------------------------------------- 113 ztortz(ji,jj,jk) = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 114 115 END DO 116 END DO 117 END DO 118 119 120 121 DO jk = 1,jpkm1 122 DO jj = 1,jpj 123 DO ji = 1,jpi 99 ! Zooplankton mortality. A square function has been selected with 100 ! no real reason except that it seems to be more stable and may mimic predation. 101 ! --------------------------------------------------------------- 102 ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 103 124 104 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 125 105 zcompadi2 = MIN( zcompadi, 5.e-7 ) … … 131 111 zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn ) 132 112 133 zgraze = grazrat * zstep * tgfunc(ji,jj,jk) & 134 # if defined key_degrad 135 & * facvol(ji,jj,jk) & 136 # endif 137 & * trn(ji,jj,jk,jpzoo) 113 zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 138 114 139 115 zinano = xpref2p * zcompaph * zdenom2 … … 143 119 zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 144 120 145 zgrazp(ji,jj,jk) = zgraze * zinano * zcompaph * zdenom 146 zgrazm(ji,jj,jk) = zgraze * zipoc * zcompapoc * zdenom 147 zgrazsd(ji,jj,jk) = zgraze * zidiat * zcompadi2 * zdenom 148 149 zgrazpf (ji,jj,jk) = zgrazp(ji,jj,jk) * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 150 zgrazmf(ji,jj,jk) = zgrazm(ji,jj,jk) * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 151 zgrazsf(ji,jj,jk) = zgrazsd(ji,jj,jk) * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 152 153 END DO 154 END DO 155 END DO 156 121 zgrazp = zgraze * zinano * zcompaph * zdenom 122 zgrazm = zgraze * zipoc * zcompapoc * zdenom 123 zgrazsd = zgraze * zidiat * zcompadi2 * zdenom 124 125 zgrazpf = zgrazp * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 126 zgrazmf = zgrazm * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 127 zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 157 128 #if defined key_diatrc 158 ! Grazing by microzooplankton 159 grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:) 160 #endif 161 162 DO jk = 1,jpkm1 163 DO jj = 1,jpj 164 DO ji = 1,jpi 165 ! Various remineralization and excretion terms 166 ! -------------------------------------------- 167 168 zgrarem = ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk) ) & 169 & * ( 1.- epsher - unass ) 170 zgrafer = ( zgrazpf(ji,jj,jk) + zgrazsf(ji,jj,jk) + zgrazmf(ji,jj,jk) ) & 171 & * ( 1.- epsher - unass ) + epsher * & 172 & ( zgrazm(ji,jj,jk) * MAX((trn(ji,jj,jk,jpsfe) /(trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 173 & + zgrazp(ji,jj,jk) * MAX((trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 174 & + zgrazsd(ji,jj,jk) * MAX((trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 ) ) 175 zgrapoc = ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk) ) * unass 129 ! Grazing by microzooplankton 130 grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd 131 #endif 132 133 ! Various remineralization and excretion terms 134 ! -------------------------------------------- 135 zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass ) 136 zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) & 137 & + epsher * ( zgrazm * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 138 & + zgrazp * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 139 & + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 ) ) 140 141 zgrapoc = ( zgrazp + zgrazm + zgrazsd ) 176 142 177 143 ! Update of the TRA arrays … … 183 149 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 184 150 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 185 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 151 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass 186 152 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 187 153 #if defined key_kriest 188 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 189 #endif 190 END DO 191 END DO 192 END DO 193 194 ! 195 ! Update the arrays TRA which contain the biological sources and sinks 196 ! -------------------------------------------------------------------- 197 198 DO jk = 1, jpkm1 199 DO jj = 1, jpj 200 DO ji = 1, jpi 201 202 zmortz = ztortz(ji,jj,jk) + zrespz(ji,jj,jk) 203 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz & 204 & + epsher * ( zgrazp(ji,jj,jk) + zgrazm(ji,jj,jk) + zgrazsd(ji,jj,jk)) 205 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp(ji,jj,jk) 206 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd(ji,jj,jk) 207 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp(ji,jj,jk) & 208 & * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 209 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd(ji,jj,jk) & 210 & * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 211 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd(ji,jj,jk) & 212 & * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 213 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd(ji,jj,jk) & 214 & * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 215 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf(ji,jj,jk) 216 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf(ji,jj,jk) 217 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm(ji,jj,jk) 218 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz & 219 & + unass * ( zgrazpf(ji,jj,jk) + zgrazsf (ji,jj,jk)) & 220 & - (1.-unass) * zgrazmf(ji,jj,jk) 221 zprcaca = xfracal(ji,jj,jk) * unass * zgrazp(ji,jj,jk) 154 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat 155 #endif 156 157 ! 158 ! Update the arrays TRA which contain the biological sources and sinks 159 ! -------------------------------------------------------------------- 160 161 zmortz = ztortz + zrespz 162 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc 163 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 164 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 165 tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazp * trn(ji,jj,jk,jpnch)/(trn(ji,jj,jk,jpphy)+rtrn) 166 tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazsd * trn(ji,jj,jk,jpdch)/(trn(ji,jj,jk,jpdia)+rtrn) 167 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) - zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 168 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zgrazsd * trn(ji,jj,jk,jpbsi)/(trn(ji,jj,jk,jpdia)+rtrn) 169 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgrazpf 170 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 171 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 172 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf 173 zprcaca = xfracal(ji,jj,jk) * unass * zgrazp 222 174 #if defined key_diatrc 223 175 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) … … 228 180 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 229 181 #if defined key_kriest 230 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm (ji,jj,jk)) * xkr_ddiat182 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ( zmortz - zgrazm ) * xkr_ddiat 231 183 #endif 232 184 END DO … … 251 203 !! 252 204 !! ** Method : Read the nampiszoo namelist and check the parameters 253 !! called at the first timestep (nit trc000)205 !! called at the first timestep (nit000) 254 206 !! 255 207 !! ** input : Namelist nampiszoo -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zmort.F90
r2038 r2104 25 25 26 26 PUBLIC p4z_mort 27 PUBLIC p4z_mort_init 27 28 28 29 … … 35 36 mpratm = 0.01_wp !: 36 37 37 !! * Module variables38 REAL(wp) :: zstep39 40 41 38 42 39 !!* Substitution … … 50 47 CONTAINS 51 48 52 SUBROUTINE p4z_mort( kt , jnt)49 SUBROUTINE p4z_mort( kt ) 53 50 !!--------------------------------------------------------------------- 54 51 !! *** ROUTINE p4z_mort *** … … 59 56 !! ** Method : - ??? 60 57 !!--------------------------------------------------------------------- 61 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 62 !!--------------------------------------------------------------------- 63 64 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_mort_init ! Initialization (first time-step only) 65 66 zstep = rfact2 / rday ! Time step duration for biology 58 INTEGER, INTENT(in) :: kt ! ocean time step 59 !!--------------------------------------------------------------------- 67 60 68 61 CALL p4z_nano ! nanophytoplankton … … 83 76 INTEGER :: ji, jj, jk 84 77 REAL(wp) :: zcompaph 85 REAL(wp) :: zfactfe, zfactch,zprcaca,zfracal86 REAL(wp) :: ztortp ,zrespp,zmortp78 REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 79 REAL(wp) :: ztortp , zrespp , zmortp , zstep 87 80 CHARACTER (len=25) :: charout 88 81 !!--------------------------------------------------------------------- … … 99 92 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 100 93 101 ! Squared mortality of Phyto similar to a sedimentation term during102 ! blooms (Doney et al. 1996)103 ! -----------------------------------------------------------------104 zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) &105 94 # if defined key_degrad 106 & * facvol(ji,jj,jk) & 95 zstep = xstep * facvol(ji,jj,jk) 96 # else 97 zstep = xstep 107 98 # endif 108 & * zcompaph * trn(ji,jj,jk,jpphy) 109 110 ! Phytoplankton mortality. This mortality loss is slightly 111 ! increased when nutrients are limiting phytoplankton growth 112 ! as observed for instance in case of iron limitation. 113 ! ---------------------------------------------------------- 114 ztortp = mprat * zstep * trn(ji,jj,jk,jpphy) & 115 # if defined key_degrad 116 & * facvol(ji,jj,jk) & 117 # endif 118 & / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 119 99 ! Squared mortality of Phyto similar to a sedimentation term during 100 ! blooms (Doney et al. 1996) 101 zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * trn(ji,jj,jk,jpphy) 102 103 ! Phytoplankton mortality. This mortality loss is slightly 104 ! increased when nutrients are limiting phytoplankton growth 105 ! as observed for instance in case of iron limitation. 106 ztortp = mprat * xstep * trn(ji,jj,jk,jpphy) / ( xkmort + trn(ji,jj,jk,jpphy) ) * zcompaph 120 107 121 108 zmortp = zrespp + ztortp … … 169 156 INTEGER :: ji, jj, jk 170 157 REAL(wp) :: zfactfe,zfactsi,zfactch, zcompadi 171 REAL(wp) :: zrespp2, ztortp2, zmortp2 158 REAL(wp) :: zrespp2, ztortp2, zmortp2, zstep 172 159 CHARACTER (len=25) :: charout 173 160 … … 175 162 176 163 177 ! Aggregation term for diatoms is increased in case of nutrient178 ! stress as observed in reality. The stressed cells become more179 ! sticky and coagulate to sink quickly out of the euphotic zone180 ! ------------------------------------------------------------164 ! Aggregation term for diatoms is increased in case of nutrient 165 ! stress as observed in reality. The stressed cells become more 166 ! sticky and coagulate to sink quickly out of the euphotic zone 167 ! ------------------------------------------------------------ 181 168 182 169 DO jk = 1, jpkm1 … … 186 173 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1e-8), 0. ) 187 174 188 ! Aggregation term for diatoms is increased in case of nutrient 189 ! stress as observed in reality. The stressed cells become more 190 ! sticky and coagulate to sink quickly out of the euphotic zone 191 ! ------------------------------------------------------------ 192 175 ! Aggregation term for diatoms is increased in case of nutrient 176 ! stress as observed in reality. The stressed cells become more 177 ! sticky and coagulate to sink quickly out of the euphotic zone 178 ! ------------------------------------------------------------ 179 180 # if defined key_degrad 181 zstep = xstep * facvol(ji,jj,jk) 182 # else 183 zstep = xstep 184 # endif 185 ! Phytoplankton respiration 186 ! ------------------------ 193 187 zrespp2 = 1.e6 * zstep * ( wchl + wchld * ( 1.- xlimdia(ji,jj,jk) ) ) & 194 # if defined key_degrad195 & * facvol(ji,jj,jk) &196 # endif197 188 & * xdiss(ji,jj,jk) * zcompadi * trn(ji,jj,jk,jpdia) 198 199 200 ! Phytoplankton mortality. 201 ! ------------------------ 202 ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia) & 203 # if defined key_degrad 204 & * facvol(ji,jj,jk) & 205 # endif 206 & / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 207 208 zmortp2 = zrespp2 + ztortp2 209 210 ! Update the arrays tra which contains the biological sources and sinks 211 ! --------------------------------------------------------------------- 189 190 ! Phytoplankton mortality. 191 ! ------------------------ 192 ztortp2 = mprat2 * zstep * trn(ji,jj,jk,jpdia) / ( xkmort + trn(ji,jj,jk,jpdia) ) * zcompadi 193 194 zmortp2 = zrespp2 + ztortp2 195 196 ! Update the arrays tra which contains the biological sources and sinks 197 ! --------------------------------------------------------------------- 212 198 zfactch = trn(ji,jj,jk,jpdch) / ( trn(ji,jj,jk,jpdia) + rtrn ) 213 199 zfactfe = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zopt.F90
r2038 r2104 22 22 PRIVATE 23 23 24 PUBLIC p4z_opt ! called in p4zbio.F90 module 24 PUBLIC p4z_opt ! called in p4zbio.F90 module 25 PUBLIC p4z_opt_init ! called in trcsms_pisces.F90 module 25 26 26 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: etot, enano, ediat !: PAR for phyto, nano and diat … … 43 44 CONTAINS 44 45 45 SUBROUTINE p4z_opt( kt, jnt)46 SUBROUTINE p4z_opt( kt, jnt ) 46 47 !!--------------------------------------------------------------------- 47 48 !! *** ROUTINE p4z_opt *** … … 63 64 64 65 65 ! !* tabulated attenuation coef. 66 IF( kt * jnt == nittrc000 ) THEN 67 ! ! level of light extinction 68 nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 69 IF(lwp) THEN 70 WRITE(numout,*) 71 WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 72 ENDIF 73 !! CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients 74 CALL trc_oce_rgb_read( xkrgb ) ! tabulated attenuation coefficients 75 etot (:,:,:) = 0.e0 76 enano(:,:,:) = 0.e0 77 ediat(:,:,:) = 0.e0 78 IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 79 ENDIF 80 81 82 ! Initialisation of variables used to compute PAR 83 ! ----------------------------------------------- 66 ! Initialisation of variables used to compute PAR 67 ! ----------------------------------------------- 84 68 ze1 (:,:,jpk) = 0.e0 85 69 ze2 (:,:,jpk) = 0.e0 … … 242 226 END SUBROUTINE p4z_opt 243 227 228 SUBROUTINE p4z_opt_init 229 !!---------------------------------------------------------------------- 230 !! *** ROUTINE p4z_opt_init *** 231 !! 232 !! ** Purpose : Initialization of tabulated attenuation coef 233 !! 234 !! 235 !!---------------------------------------------------------------------- 236 237 ! ! level of light extinction 238 nksrp = trc_oce_ext_lev( rn_si2, 0.33e2 ) 239 IF(lwp) THEN 240 WRITE(numout,*) 241 WRITE(numout,*) ' level max of computation of qsr = ', nksrp, ' ref depth = ', gdepw_0(nksrp+1), ' m' 242 ENDIF 243 !! CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients 244 CALL trc_oce_rgb_read( xkrgb ) ! tabulated attenuation coefficients 245 etot (:,:,:) = 0.e0 246 enano(:,:,:) = 0.e0 247 ediat(:,:,:) = 0.e0 248 IF( ln_qsr_bio ) etot3(:,:,:) = 0.e0 249 ! 250 END SUBROUTINE p4z_opt_init 244 251 #else 245 252 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zprod.F90
r2082 r2104 27 27 PRIVATE 28 28 29 PUBLIC p4z_prod ! called in p4zbio.F90 29 PUBLIC p4z_prod ! called in p4zbio.F90 30 PUBLIC p4z_prod_init ! called in trcsms_pisces.F90 30 31 31 32 !! * Shared module variables … … 47 48 texcret , & !: 1 - excret 48 49 texcret2 , & !: 1 - excret2 49 rpis180 , & !: rpi / 18050 50 tpp !: Total primary production 51 51 … … 78 78 REAL(wp) :: zmxltst, zmxlday, zlim1 79 79 REAL(wp) :: zpislopen , zpislope2n 80 REAL(wp) :: zrum, zcodel, zargu, zv ol80 REAL(wp) :: zrum, zcodel, zargu, zval, zvol 81 81 #if defined key_diatrc 82 82 REAL(wp) :: zrfact2 … … 91 91 !!--------------------------------------------------------------------- 92 92 93 94 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_prod_init ! Initialization (first time-step only)95 96 97 93 zprorca (:,:,:) = 0.0 98 94 zprorcad(:,:,:) = 0.0 … … 125 121 zrum = FLOAT( nday_year - 80 ) / 365. 126 122 ENDIF 127 zcodel = ASIN( SIN( zrum * rpi * 2. ) * SIN( r pis180* 23.5 ) )123 zcodel = ASIN( SIN( zrum * rpi * 2. ) * SIN( rad * 23.5 ) ) 128 124 129 125 ! day length in hours … … 131 127 DO jj = 1, jpj 132 128 DO ji = 1, jpi 133 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * r pis180)129 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 134 130 zargu = MAX( -1., MIN( 1., zargu ) ) 135 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rpis180 / 15. ) 131 zval = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 132 IF( zval < 1.e0 ) zval = 24. 133 zstrn(ji,jj) = 24. / zval 136 134 END DO 137 135 END DO … … 227 225 END DO 228 226 229 230 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24.231 zstrn(:,:) = 24. / zstrn(:,:)232 227 233 228 !CDIR NOVERRCHK … … 396 391 !! 397 392 !! ** Method : Read the nampisprod namelist and check the parameters 398 !! called at the first timestep (nit trc000)393 !! called at the first timestep (nit000) 399 394 !! 400 395 !! ** input : Namelist nampisprod … … 426 421 nspyr = INT( nyear_len(1) * rday / rdt ) 427 422 428 rpis180 = rpi / 180.429 423 texcret = 1.0 - excret 430 424 texcret2 = 1.0 - excret2 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zrem.F90
r2082 r2104 27 27 PRIVATE 28 28 29 PUBLIC p4z_rem ! called in p4zbio.F90 29 PUBLIC p4z_rem ! called in p4zbio.F90 30 PUBLIC p4z_rem_init ! called in trcsms_pisces.F90 30 31 31 32 !! * Shared module variables … … 41 42 & denitr !: denitrification array 42 43 43 REAL(wp) :: &44 xstep !: Time step duration for biology45 44 46 45 !!* Substitution … … 54 53 CONTAINS 55 54 56 SUBROUTINE p4z_rem( kt, jnt)55 SUBROUTINE p4z_rem( kt ) 57 56 !!--------------------------------------------------------------------- 58 57 !! *** ROUTINE p4z_rem *** … … 62 61 !! ** Method : - ??? 63 62 !!--------------------------------------------------------------------- 64 INTEGER, INTENT(in) :: kt , jnt! ocean time step63 INTEGER, INTENT(in) :: kt ! ocean time step 65 64 INTEGER :: ji, jj, jk 66 65 REAL(wp) :: zremip, zremik , zlam1b 67 66 REAL(wp) :: zkeq , zfeequi, zsiremin 68 REAL(wp) :: zsatur, zsatur2, znusil 67 REAL(wp) :: zsatur, zsatur1, zsatur2, zsatur22, znusil 68 REAL(wp) :: ztem1, ztem2 69 69 REAL(wp) :: zbactfer, zorem, zorem2, zofer 70 70 REAL(wp) :: zosil, zdenom1, zscave, zaggdfe … … 72 72 REAL(wp) :: zofer2, zdenom, zdenom2 73 73 #endif 74 REAL(wp) :: zlamfac, zonitr 74 REAL(wp) :: zlamfac, zonitr, zstep 75 75 REAL(wp), DIMENSION(jpi,jpj) :: ztempbac 76 76 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepbac, zfesatur, zolimi … … 78 78 79 79 !!--------------------------------------------------------------------- 80 81 82 IF( ( kt * jnt ) == nittrc000 ) THEN83 CALL p4z_rem_init ! Initialization (first time-step only)84 xstep = rfact2 / rday ! Time step duration for the biology85 nitrfac(:,:,:) = 0.086 denitr (:,:,:) = 0.087 ENDIF88 80 89 81 … … 94 86 ztempbac(:,:) = 0.0 95 87 96 !Computation of the mean phytoplankton concentration as97 !a crude estimate of the bacterial biomass98 !--------------------------------------------------88 ! Computation of the mean phytoplankton concentration as 89 ! a crude estimate of the bacterial biomass 90 ! -------------------------------------------------- 99 91 100 92 DO jk = 1, jpkm1 … … 114 106 DO jj = 1, jpj 115 107 DO ji = 1, jpi 116 117 ! DENITRIFICATION FACTOR COMPUTED FROM O2 LEVELS 118 ! ---------------------------------------------- 119 108 ! denitrification factor computed from O2 levels 120 109 nitrfac(ji,jj,jk) = MAX( 0.e0, 0.4 * ( 6.e-6 - trn(ji,jj,jk,jpoxy) ) & 121 110 & / ( oxymin + trn(ji,jj,jk,jpoxy) ) ) 122 END DO 123 END DO 124 END DO 125 126 nitrfac(:,:,:) = MIN( 1., nitrfac(:,:,:) ) 127 128 129 DO jk = 1, jpkm1 130 DO jj = 1, jpj 131 DO ji = 1, jpi 132 133 ! DOC ammonification. Depends on depth, phytoplankton biomass 134 ! and a limitation term which is supposed to be a parameterization 135 ! of the bacterial activity. 136 ! ---------------------------------------------------------------- 137 zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) & 111 nitrfac(ji,jj,jk) = MIN( 1., nitrfac(ji,jj,jk) ) 112 END DO 113 END DO 114 END DO 115 116 DO jk = 1, jpkm1 117 DO jj = 1, jpj 118 DO ji = 1, jpi 138 119 # if defined key_degrad 139 & * facvol(ji,jj,jk) & 120 zstep = xstep * facvol(ji,jj,jk) 121 # else 122 zstep = xstep 140 123 # endif 141 & * zdepbac(ji,jj,jk) 124 ! DOC ammonification. Depends on depth, phytoplankton biomass 125 ! and a limitation term which is supposed to be a parameterization 126 ! of the bacterial activity. 127 zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 142 128 zremik = MAX( zremik, 5.5e-4 * xstep ) 143 129 144 ! Ammonification in oxic waters with oxygen consumption145 ! -----------------------------------------------------130 ! Ammonification in oxic waters with oxygen consumption 131 ! ----------------------------------------------------- 146 132 zolimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, & 147 133 & zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc) ) 148 134 149 ! Ammonification in suboxic waters with denitrification150 ! -------------------------------------------------------135 ! Ammonification in suboxic waters with denitrification 136 ! ------------------------------------------------------- 151 137 denitr(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit, & 152 138 & zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc) ) … … 167 153 DO jj = 1, jpj 168 154 DO ji = 1, jpi 169 170 ! NH4 nitrification to NO3. Ceased for oxygen concentrations171 ! below 2 umol/L. Inhibited at strong light172 ! ----------------------------------------------------------173 zonitr = nitrif * xstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) &174 155 # if defined key_degrad 175 & * facvol(ji,jj,jk) & 156 zstep = xstep * facvol(ji,jj,jk) 157 # else 158 zstep = xstep 176 159 # endif 177 & * ( 1.- nitrfac(ji,jj,jk) ) 178 179 ! 180 ! Update of the tracers trends 181 ! ---------------------------- 182 183 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 184 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 185 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 186 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3 * zonitr 160 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 161 ! below 2 umol/L. Inhibited at strong light 162 ! ---------------------------------------------------------- 163 zonitr = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 164 165 ! Update of the tracers trends 166 ! ---------------------------- 167 168 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 169 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 170 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 171 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3 * zonitr 187 172 188 173 END DO … … 200 185 DO ji = 1, jpi 201 186 202 ! Bacterial uptake of iron. No iron is available in DOC. So 203 ! Bacteries are obliged to take up iron from the water. Some 204 ! studies (especially at Papa) have shown this uptake to be 205 ! significant 206 ! ---------------------------------------------------------- 187 ! Bacterial uptake of iron. No iron is available in DOC. So 188 ! Bacteries are obliged to take up iron from the water. Some 189 ! studies (especially at Papa) have shown this uptake to be significant 190 ! ---------------------------------------------------------- 207 191 zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk) & 208 & * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))**2 & 192 & * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk)) & 193 & * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk)) & 209 194 & / ( xkgraz2 + zdepbac(ji,jj,jk) ) & 210 195 & * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 ) ) … … 216 201 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer 217 202 #endif 218 219 203 END DO 220 204 END DO … … 230 214 DO jj = 1, jpj 231 215 DO ji = 1, jpi 232 233 ! POC disaggregation by turbulence and bacterial activity.234 ! -------------------------------------------------------------235 zremip = xremip * xstep * tgfunc(ji,jj,jk) &236 216 # if defined key_degrad 237 & * facvol(ji,jj,jk) & 217 zstep = xstep * facvol(ji,jj,jk) 218 # else 219 zstep = xstep 238 220 # endif 239 & * ( 1.- 0.5 * nitrfac(ji,jj,jk) ) 240 241 ! POC disaggregation rate is reduced in anoxic zone as shown by 242 ! sediment traps data. In oxic area, the exponent of the martin s 243 ! law is around -0.87. In anoxic zone, it is around -0.35. This 244 ! means a disaggregation constant about 0.5 the value in oxic zones 245 ! ----------------------------------------------------------------- 221 ! POC disaggregation by turbulence and bacterial activity. 222 ! ------------------------------------------------------------- 223 zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) ) 224 225 ! POC disaggregation rate is reduced in anoxic zone as shown by 226 ! sediment traps data. In oxic area, the exponent of the martin s 227 ! law is around -0.87. In anoxic zone, it is around -0.35. This 228 ! means a disaggregation constant about 0.5 the value in oxic zones 229 ! ----------------------------------------------------------------- 246 230 zorem = zremip * trn(ji,jj,jk,jppoc) 247 231 zofer = zremip * trn(ji,jj,jk,jpsfe) … … 253 237 #endif 254 238 255 ! Update the appropriate tracers trends256 ! -------------------------------------239 ! Update the appropriate tracers trends 240 ! ------------------------------------- 257 241 258 242 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem … … 282 266 DO jj = 1, jpj 283 267 DO ji = 1, jpi 284 285 ! Remineralization rate of BSi depedant on T and saturation 286 ! --------------------------------------------------------- 287 zsatur = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 288 zsatur = MAX( rtrn, zsatur ) 289 zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 290 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9 291 # if defined key_degrad 292 zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk) 268 # if defined key_degrad 269 zstep = xstep * facvol(ji,jj,jk) 293 270 # else 294 zsiremin = xsirem * xstep * znusil 295 # endif 296 zosil = zsiremin * trn(ji,jj,jk,jpdsi) 271 zstep = xstep 272 # endif 273 ! Remineralization rate of BSi depedant on T and saturation 274 ! --------------------------------------------------------- 275 zsatur = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 276 zsatur = MAX( rtrn, zsatur ) 277 ztem1 = ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) 278 ztem2 = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.) 279 zsatur1 = zsatur * ztem1 280 zsatur2 = zsatur * ztem2 * ztem2 * ztem2 * ztem2 281 zsatur22 = zsatur2 * zsatur2 282 znusil = 0.225 * zsatur1 + 0.775 * zsatur22 * zsatur22 * zsatur22 * zsatur22 * zsatur2 283 zsiremin = xsirem * zstep * znusil 284 zosil = zsiremin * trn(ji,jj,jk,jpdsi) 297 285 298 286 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 299 287 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 300 301 288 ! 302 289 END DO … … 317 304 !CDIR NOVERRCHK 318 305 DO ji = 1, jpi 319 ! 320 ! Compute de different ratios for scavenging of iron 321 ! -------------------------------------------------- 306 # if defined key_degrad 307 zstep = xstep * facvol(ji,jj,jk) 308 # else 309 zstep = xstep 310 # endif 311 ! Compute de different ratios for scavenging of iron 312 ! -------------------------------------------------- 322 313 323 314 #if defined key_kriest 324 315 zdenom1 = trn(ji,jj,jk,jppoc) / & 325 316 & ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 326 317 #else 327 318 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) & 328 319 & + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 329 320 330 zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 331 zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 332 #endif 333 334 335 ! scavenging rate of iron. this scavenging rate depends on the 336 ! load in particles on which they are adsorbed. The 337 ! parameterization has been taken from studies on Th 338 ! ------------------------------------------------------------ 321 zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 322 zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 323 #endif 324 ! scavenging rate of iron. this scavenging rate depends on the load in particles 325 ! on which they are adsorbed. The parameterization has been taken from studies on Th 326 ! ------------------------------------------------------------ 339 327 zkeq = fekeq(ji,jj,jk) 340 328 zfeequi = ( -( 1. + zfesatur(ji,jj,jk) * zkeq - zkeq * trn(ji,jj,jk,jpfer) ) & … … 349 337 & + trn(ji,jj,jk,jpcal) + trn(ji,jj,jk,jpdsi) ) * 1.e6 350 338 #endif 351 352 # if defined key_degrad 353 zscave = zfeequi * zlam1b * xstep * facvol(ji,jj,jk) 354 # else 355 zscave = zfeequi * zlam1b * xstep 356 # endif 357 358 ! Increased scavenging for very high iron concentrations 359 ! found near the coasts due to increased lithogenic particles 360 ! and let s say it unknown processes (precipitation, ...) 361 ! ----------------------------------------------------------- 339 zscave = zfeequi * zlam1b * zstep 340 341 ! Increased scavenging for very high iron concentrations 342 ! found near the coasts due to increased lithogenic particles 343 ! and let s say it unknown processes (precipitation, ...) 344 ! ----------------------------------------------------------- 362 345 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 363 346 zlamfac = MIN( 1. , zlamfac ) … … 374 357 #endif 375 358 376 # if defined key_degrad 377 zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) * facvol(ji,jj,jk) 378 # else 379 zaggdfe = zlam1b * xstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 380 # endif 359 zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 381 360 382 361 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe … … 400 379 ENDIF 401 380 402 ! Update the arrays TRA which contain the biological sources and sinks403 ! --------------------------------------------------------------------381 ! Update the arrays TRA which contain the biological sources and sinks 382 ! -------------------------------------------------------------------- 404 383 405 384 DO jk = 1, jpkm1 … … 452 431 ENDIF 453 432 433 nitrfac(:,:,:) = 0.0 434 denitr (:,:,:) = 0.0 435 454 436 END SUBROUTINE p4z_rem_init 455 456 457 458 459 437 460 438 #else -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zsed.F90
r2082 r2104 34 34 35 35 PUBLIC p4z_sed 36 PUBLIC p4z_sed_init 36 37 37 38 !! * Shared module variables … … 90 91 #endif 91 92 REAL(wp) :: zconctmp , zdenitot , znitrpottot 92 REAL(wp) :: zlim, zconctmp2, z step, zfact93 REAL(wp) :: zlim, zconctmp2, zfact, zrivalk 93 94 REAL(wp), DIMENSION(jpi,jpj) :: zsidep 94 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znitrpot, zirondep … … 102 103 !!--------------------------------------------------------------------- 103 104 104 105 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_sed_init ! Initialization (first time-step only) 106 IF( (jnt == 1) .and. ( ln_dustfer ) ) CALL p4z_sbc( kt ) 107 108 zstep = rfact2 / rday ! Time step duration for the biology 105 IF( ( jnt == 1 ) .AND. ( ln_dustfer ) ) CALL p4z_sbc( kt ) 109 106 110 107 zirondep(:,:,:) = 0.e0 ! Initialisation of variables used to compute deposition … … 192 189 DO ji = 1, jpi 193 190 ikt = MAX( mbathy(ji,jj) - 1, 1 ) 194 zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt) &195 191 # if ! defined key_kriest 196 & * wscal (ji,jj,ikt)192 zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wscal (ji,jj,ikt) 197 193 # else 198 &* wsbio4(ji,jj,ikt)194 zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wsbio4(ji,jj,ikt) 199 195 # endif 200 196 trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp 201 197 202 198 #if ! defined key_sed 203 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp &204 & * ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi )199 zrivalk = ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 200 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp * zrivalk 205 201 #endif 206 202 END DO … … 210 206 DO ji = 1, jpi 211 207 ikt = MAX( mbathy(ji,jj) - 1, 1 ) 212 zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt)208 zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * xstep / fse3t(ji,jj,ikt) 213 209 trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp 214 215 210 #if ! defined key_sed 216 trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp & 217 & * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) * 2.e0 218 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp & 219 & * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 211 zrivalk = ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 212 trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp * zrivalk * 2.0 213 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp * zrivalk 220 214 #endif 221 215 END DO … … 225 219 DO ji = 1, jpi 226 220 ikt = MAX( mbathy(ji,jj) - 1, 1 ) 227 zfact = zstep / fse3t(ji,jj,ikt)221 zfact = xstep / fse3t(ji,jj,ikt) 228 222 # if ! defined key_kriest 229 223 zconctmp = trn(ji,jj,ikt,jpgoc) … … 242 236 zconctmp = trn(ji,jj,ikt,jpnum) 243 237 zconctmp2 = trn(ji,jj,ikt,jppoc) 244 trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) & 245 & - zconctmp * wsbio4(ji,jj,ikt) * zfact 246 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) & 247 & - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 238 trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - zconctmp * wsbio4(ji,jj,ikt) * zfact 239 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 248 240 #if ! defined key_sed 249 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 250 & + ( zconctmp2 * wsbio3(ji,jj,ikt) ) & 251 & * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 241 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + ( zconctmp2 * wsbio3(ji,jj,ikt) ) 242 & * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 252 243 #endif 253 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) & 254 & - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 255 244 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 256 245 # endif 257 246 END DO … … 383 372 imois2 = nmonth 384 373 385 ! 1. first call kt=nit trc000374 ! 1. first call kt=nit000 386 375 ! ----------------------- 387 376 388 IF( kt == nit trc000 ) THEN377 IF( kt == nit000 ) THEN 389 378 ! initializations 390 379 nflx1 = 0 … … 402 391 ! ---------------- 403 392 404 IF( kt == nit trc000 .OR. imois /= nflx1 ) THEN393 IF( kt == nit000 .OR. imois /= nflx1 ) THEN 405 394 406 395 ! Calendar computation … … 445 434 !! 446 435 !! ** Method : Read the files and compute the budget 447 !! called at the first timestep (nit trc000)436 !! called at the first timestep (nit000) 448 437 !! 449 438 !! ** input : external netcdf files -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zsink.F90
r2038 r2104 19 19 PRIVATE 20 20 21 PUBLIC p4z_sink ! called in p4zbio.F90 21 PUBLIC p4z_sink ! called in p4zbio.F90 22 PUBLIC p4z_sink_init ! called in trcsms_pisces.F90 22 23 23 24 !! * Shared module variables … … 31 32 sinkcal, sinksil, & !: CaCO3 and BSi sinking fluxes 32 33 sinkfer !: Small BFe sinking flux 33 34 REAL(wp) :: &35 xstep , xstep2 !: Time step duration for biology36 34 37 35 INTEGER :: & … … 106 104 !!--------------------------------------------------------------------- 107 105 108 IF( ( kt * jnt ) == nittrc000 ) THEN 109 CALL p4z_sink_init ! Initialization (first time-step only) 110 xstep = rfact2 / rday ! Time step duration for biology 111 xstep2 = rfact2 / 2. 112 ENDIF 113 114 ! Initialisation of variables used to compute Sinking Speed 115 ! --------------------------------------------------------- 106 ! Initialisation of variables used to compute Sinking Speed 107 ! --------------------------------------------------------- 116 108 117 109 znum3d(:,:,:) = 0.e0 … … 120 112 zval3 = 1. + xkr_eta 121 113 122 ! Computation of the vertical sinking speed : Kriest et Evans, 2000123 ! -----------------------------------------------------------------114 ! Computation of the vertical sinking speed : Kriest et Evans, 2000 115 ! ----------------------------------------------------------------- 124 116 125 117 DO jk = 1, jpkm1 … … 128 120 IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 129 121 znum = trn(ji,jj,jk,jppoc) / ( trn(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 130 ! -------------- To avoid sinking speed over 50 m/day -------122 ! -------------- To avoid sinking speed over 50 m/day ------- 131 123 znum = MIN( xnumm(jk), znum ) 132 124 znum = MAX( 1.1 , znum ) 133 125 znum3d(ji,jj,jk) = znum 134 !------------------------------------------------------------126 !------------------------------------------------------------ 135 127 zeps = ( zval1 * znum - 1. )/ ( znum - 1. ) 136 128 zfm = xkr_frac**( 1. - zeps ) … … 150 142 wscal(:,:,:) = MAX( wsbio3(:,:,:), 50. ) 151 143 152 153 ! INITIALIZE TO ZERO ALL THE SINKING ARRAYS 154 ! ----------------------------------------- 144 ! INITIALIZE TO ZERO ALL THE SINKING ARRAYS 145 ! ----------------------------------------- 155 146 156 147 sinking (:,:,:) = 0.e0 … … 160 151 sinksil (:,:,:) = 0.e0 161 152 162 ! Compute the sedimentation term using p4zsink2 for all 163 ! the sinking particles 164 ! ----------------------------------------------------- 153 ! Compute the sedimentation term using p4zsink2 for all the sinking particles 154 ! ----------------------------------------------------- 165 155 166 156 CALL p4z_sink2( wsbio3, sinking , jppoc ) … … 170 160 CALL p4z_sink2( wscal , sinkcal , jpcal ) 171 161 172 ! Exchange between organic matter compartments due to 173 ! coagulation/disaggregation 174 ! --------------------------------------------------- 162 ! Exchange between organic matter compartments due to coagulation/disaggregation 163 ! --------------------------------------------------- 175 164 176 165 zval1 = 1. + xkr_zeta … … 185 174 186 175 znum = trn(ji,jj,jk,jppoc)/(trn(ji,jj,jk,jpnum)+rtrn) / xkr_massp 187 !-------------- To avoid sinking speed over 50 m/day -------176 !-------------- To avoid sinking speed over 50 m/day ------- 188 177 znum = min(xnumm(jk),znum) 189 178 znum = MAX( 1.1,znum) 190 !------------------------------------------------------------179 !------------------------------------------------------------ 191 180 zeps = ( zval1 * znum - 1.) / ( znum - 1.) 192 181 zdiv = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 ) … … 199 188 zsm = xkr_frac**xkr_eta 200 189 201 ! Part I : Coagulation dependant on turbulence202 ! ----------------------------------------------190 ! Part I : Coagulation dependant on turbulence 191 ! ---------------------------------------------- 203 192 204 193 zagg1 = ( 0.163 * trn(ji,jj,jk,jpnum)**2 & … … 232 221 zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 233 222 234 ! Aggregation of small into large particles235 ! Part II : Differential settling236 ! ----------------------------------------------223 ! Aggregation of small into large particles 224 ! Part II : Differential settling 225 ! ---------------------------------------------- 237 226 238 227 zagg4 = ( 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2* & … … 261 250 zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 262 251 263 ! Aggregation of DOC to small particles264 ! --------------------------------------252 ! Aggregation of DOC to small particles 253 ! -------------------------------------- 265 254 266 255 zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc) & … … 473 462 REAL(wp) :: zagg1, zagg2, zagg3, zagg4 474 463 REAL(wp) :: zagg , zaggfe, zaggdoc, zaggdoc2 475 REAL(wp) :: zfact, zwsmax 464 REAL(wp) :: zfact, zwsmax, zstep 476 465 #if defined key_diatrc 477 466 REAL(wp) :: zrfact2 … … 481 470 !!--------------------------------------------------------------------- 482 471 483 IF( ( kt * jnt ) == nittrc000 ) THEN 484 xstep = rfact2 / rday ! Timestep duration for biology 485 xstep2 = rfact2 / 2. 486 ENDIF 487 488 ! Sinking speeds of detritus is increased with depth as shown 489 ! by data and from the coagulation theory 490 ! ----------------------------------------------------------- 472 ! Sinking speeds of detritus is increased with depth as shown 473 ! by data and from the coagulation theory 474 ! ----------------------------------------------------------- 491 475 DO jk = 1, jpkm1 492 476 DO jj = 1, jpj 493 477 DO ji=1,jpi 494 zfact = MAX( 0., fsdepw(ji,jj,jk+1) -hmld(ji,jj) ) / 4000.478 zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000. 495 479 wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 496 480 END DO … … 498 482 END DO 499 483 500 ! LIMIT THE VALUES OF THE SINKING SPEEDS 501 ! TO AVOID NUMERICAL INSTABILITIES 502 484 ! limit the values of the sinking speeds to avoid numerical instabilities 503 485 wsbio3(:,:,:) = wsbio 504 !505 ! OA Below, this is garbage. the ideal would be to find a time-splitting 506 ! OA algorithm that does not increase the computing cost by too much507 ! OA In ROMS, I have included a time-splitting procedure. But it is508 ! OA too expensive as the loop is computed globally. Thus, a small e3t509 ! OA at one place determines the number of subtimesteps globally510 ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !!486 ! 487 ! OA Below, this is garbage. the ideal would be to find a time-splitting 488 ! OA algorithm that does not increase the computing cost by too much 489 ! OA In ROMS, I have included a time-splitting procedure. But it is 490 ! OA too expensive as the loop is computed globally. Thus, a small e3t 491 ! OA at one place determines the number of subtimesteps globally 492 ! OA AWFULLY EXPENSIVE !! Not able to find a better approach. Damned !! 511 493 512 494 DO jk = 1,jpkm1 … … 522 504 wscal(:,:,:) = wsbio4(:,:,:) 523 505 524 ! INITIALIZE TO ZERO ALL THE SINKING ARRAYS 525 ! -----------------------------------------506 ! Initializa to zero all the sinking arrays 507 ! ----------------------------------------- 526 508 527 509 sinking (:,:,:) = 0.e0 … … 532 514 sinkfer2(:,:,:) = 0.e0 533 515 534 ! Compute the sedimentation term using p4zsink2 for all 535 ! the sinking particles 536 ! ----------------------------------------------------- 516 ! Compute the sedimentation term using p4zsink2 for all the sinking particles 517 ! ----------------------------------------------------- 537 518 538 519 CALL p4z_sink2( wsbio3, sinking , jppoc ) … … 543 524 CALL p4z_sink2( wscal , sinkcal , jpcal ) 544 525 545 ! Exchange between organic matter compartments due to 546 ! coagulation/disaggregation 547 ! --------------------------------------------------- 526 ! Exchange between organic matter compartments due to coagulation/disaggregation 527 ! --------------------------------------------------- 548 528 549 529 DO jk = 1, jpkm1 550 530 DO jj = 1, jpj 551 531 DO ji = 1, jpi 552 zfact = xstep * xdiss(ji,jj,jk) 532 # if defined key_degrad 533 zstep = xstep * facvol(ji,jj,jk) 534 # else 535 zstep = xstep 536 # endif 537 zfact = zstep * xdiss(ji,jj,jk) 553 538 ! Part I : Coagulation dependent on turbulence 554 # if defined key_degrad555 zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk)556 zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk)557 # else558 539 zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 559 540 zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 560 # endif561 541 562 542 ! Part II : Differential settling 563 543 564 544 ! Aggregation of small into large particles 565 # if defined key_degrad 566 zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 567 zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 568 # else 569 zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 570 zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 571 # endif 545 zagg3 = 0.66 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 546 zagg4 = 0.e0 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 547 572 548 zagg = zagg1 + zagg2 + zagg3 + zagg4 573 549 zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 574 550 575 551 ! Aggregation of DOC to small particles 576 #if defined key_degrad 577 zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) & 578 & * facvol(ji,jj,jk) * zfact * trn(ji,jj,jk,jpdoc) 579 zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) & 580 & * facvol(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 581 #else 582 zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) & 583 & * zfact * trn(ji,jj,jk,jpdoc) 552 zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc) 584 553 zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 585 #endif 554 586 555 ! Update the trends 587 556 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc … … 623 592 END SUBROUTINE p4z_sink 624 593 594 SUBROUTINE p4z_sink_init 595 !!---------------------------------------------------------------------- 596 !! *** ROUTINE p4z_sink_init *** 597 !!---------------------------------------------------------------------- 598 END SUBROUTINE p4z_sink_init 599 625 600 #endif 626 601 … … 641 616 !! 642 617 INTEGER :: ji, jj, jk, jn 643 REAL(wp) :: zigma,zew,zign, zflx 618 REAL(wp) :: zigma,zew,zign, zflx, zstep 644 619 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztraz, zakz 645 620 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwsink2 646 621 !!--------------------------------------------------------------------- 647 622 623 624 zstep = rfact2 / 2. 648 625 649 626 ztraz(:,:,:) = 0.e0 … … 693 670 DO jj = 1, jpj 694 671 DO ji = 1, jpi 695 zigma = zwsink2(ji,jj,jk+1) * xstep2/ fse3w(ji,jj,jk+1)672 zigma = zwsink2(ji,jj,jk+1) * zstep / fse3w(ji,jj,jk+1) 696 673 zew = zwsink2(ji,jj,jk+1) 697 psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * xstep2674 psinkflx(ji,jj,jk+1) = -zew * ( trn(ji,jj,jk,jp_tra) - 0.5 * ( 1 + zigma ) * zakz(ji,jj,jk) ) * zstep 698 675 END DO 699 676 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r2038 r2104 23 23 REAL(wp) :: rfact , rfactr !: ??? 24 24 REAL(wp) :: rfact2, rfact2r !: ??? 25 REAL(wp) :: xstep !: Time step duration for biology 25 26 26 27 !!* Biological parameters -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r2038 r2104 145 145 ! ----------------------- 146 146 #if defined key_kriest 147 IF( jp_pisces /= 23) THEN147 IF( jp_pisces /= 23) CALL ctl_stop( ' PISCES must have 23 passive tracers. Change jp_pisces in par_pisces.F90' ) 148 148 #else 149 IF( jp_pisces /= 24) THEN149 IF( jp_pisces /= 24) CALL ctl_stop( ' PISCES must have 24 passive tracers. Change jp_pisces in par_pisces.F90' ) 150 150 #endif 151 IF (lwp) THEN152 WRITE (numout,*) ' ===>>>> : w a r n i n g '153 WRITE (numout,*) ' ======= ============= '154 WRITE (numout,*) &155 & ' STOP, change jp_pisces', &156 & ' in par_pisces.F90'157 END IF158 STOP 'TRC_CTL'159 END IF160 151 161 152 END SUBROUTINE trc_ctl_pisces -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
r2038 r2104 263 263 #if defined key_dtatrc 264 264 ! Restore close seas values to initial data 265 CALL trc_dta( nit trc000 )265 CALL trc_dta( nit000 ) 266 266 DO jn = 1, jptra 267 267 IF( lutini(jn) ) THEN -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r2038 r2104 22 22 USE p4zche ! 23 23 USE p4zbio ! 24 USE p4zsink ! 25 USE p4zopt ! 26 USE p4zlim ! 27 USE p4zprod ! 28 USE p4zmort ! 29 USE p4zmicro ! 30 USE p4zmeso ! 31 USE p4zrem ! 24 32 USE p4zsed ! 25 33 USE p4zlys ! … … 61 69 !!--------------------------------------------------------------------- 62 70 63 IF( kt == nit trc000 .AND. .NOT. ln_rsttr) CALL trc_sms_pisces_init ! Initialization (first time-step only)71 IF( kt == nit000 ) CALL trc_sms_pisces_init ! Initialization (first time-step only) 64 72 65 73 IF( ndayflxtr /= nday ) THEN ! New days … … 121 129 REAL(wp) :: ztmas, ztmas1 122 130 123 ! Initialization of chemical variables of the carbon cycle 124 ! -------------------------------------------------------- 125 DO jk = 1, jpk 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 ztmas = tmask(ji,jj,jk) 129 ztmas1 = 1. - tmask(ji,jj,jk) 130 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 131 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 132 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 133 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 131 IF( .NOT. ln_rsttr ) THEN 132 ! Initialization of chemical variables of the carbon cycle 133 ! -------------------------------------------------------- 134 DO jk = 1, jpk 135 DO jj = 1, jpj 136 DO ji = 1, jpi 137 ztmas = tmask(ji,jj,jk) 138 ztmas1 = 1. - tmask(ji,jj,jk) 139 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 140 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 141 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 142 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 143 END DO 134 144 END DO 135 145 END DO 136 END DO 146 ! 147 END IF 148 149 ! Time step duration for biology 150 xstep = rfact2 / rday 151 152 CALL p4z_sink_init ! vertical flux of particulate organic matter 153 CALL p4z_opt_init ! Optic: PAR in the water column 154 CALL p4z_lim_init ! co-limitations by the various nutrients 155 CALL p4z_prod_init ! phytoplankton growth rate over the global ocean. 156 CALL p4z_rem_init ! remineralisation 157 CALL p4z_mort_init ! phytoplankton mortality 158 CALL p4z_micro_init ! microzooplankton 159 CALL p4z_meso_init ! mesozooplankton 160 CALL p4z_sed_init ! sedimentation 161 CALL p4z_lys_init ! calcite saturation 162 CALL p4z_flx_init ! gas exchange 137 163 138 164 END SUBROUTINE trc_sms_pisces_init -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/sed.F90
r2082 r2104 38 38 USE trc, ONLY : & 39 39 trn , & !: tracer 40 nittrc000 , & !: 1st time step of tracer model41 40 nwritetrc !: outputs frequency of tracer model 42 41 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/sedini.F90
r1581 r2104 443 443 444 444 dtsed = rdt 445 nitsed000 = nit000 446 nitsedend = nitend 445 447 #if ! defined key_sed_off 446 nitsed000 = nittrc000447 nitsedend = nitend448 448 nwrised = nwritetrc 449 449 #else 450 nitsed000 = nit000451 nitsedend = nitend452 450 nwrised = nwrite 453 451 #endif -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/oce_trc.F90
r2085 r2104 6 6 !! History : 1.0 ! 2004-03 (C. Ethe) original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) rewritting 8 !!----------------------------------------------------------------------9 !! NEMO/TOP 2.0, LOCEAN-IPSL (2007)10 !! $Id$11 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)12 8 !!---------------------------------------------------------------------- 13 9 #if defined key_top … … 254 250 #endif 255 251 252 !!---------------------------------------------------------------------- 253 !! NEMO/TOP 3.3, LOCEAN-IPSL (2010) 254 !! $Id$ 255 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 256 256 !!====================================================================== 257 257 END MODULE oce_trc -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/par_trc.F90
r2052 r2104 9 9 !! 1.0 ! 2004-03 (C. Ethe) Free form and module 10 10 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 11 !!----------------------------------------------------------------------12 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)13 !! $Id$14 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)15 11 !!---------------------------------------------------------------------- 16 12 USE par_kind ! kind parameters … … 41 37 42 38 REAL(wp), PUBLIC :: rtrn = 1.e-15 !: truncation value 39 40 !!---------------------------------------------------------------------- 41 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 43 44 !!====================================================================== 44 45 END MODULE par_trc -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/prtctl_trc.F90
r1581 r2104 35 35 PUBLIC prt_ctl_trc_info ! 36 36 PUBLIC prt_ctl_trc_init ! called by opa.F90 37 38 !!----------------------------------------------------------------------39 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)40 !! $Id$41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)42 !!----------------------------------------------------------------------43 37 44 38 CONTAINS … … 466 460 !!---------------------------------------------------------------------- 467 461 #endif 468 469 !!====================================================================== 462 463 !!---------------------------------------------------------------------- 464 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 465 !! $Id$ 466 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 467 !!====================================================================== 470 468 END MODULE prtctl_trc -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/top_substitute.h90
r2052 r2104 2 2 !! *** top_substitute.h90 *** 3 3 !!---------------------------------------------------------------------- 4 !! ** purpose : Statement function file: to be include in all routines 5 !! concerning passive tracer model 4 !! ** purpose : Statement function file: to be include in all passive tracer modules 6 5 !!---------------------------------------------------------------------- 7 6 !! History : 1.0 ! 2004-03 (C. Ethe) Original code 8 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) new architecture 9 8 !!---------------------------------------------------------------------- 10 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 9 # include "domzgr_substitute.h90" 10 # include "ldfeiv_substitute.h90" 11 # include "ldftra_substitute.h90" 12 # include "vectopt_loop_substitute.h90" 13 !!---------------------------------------------------------------------- 14 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 11 15 !! $Id$ 12 16 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 13 17 !!---------------------------------------------------------------------- 14 ! ========================================================15 #include "domzgr_substitute.h90"16 #include "ldfeiv_substitute.h90"17 #include "ldftra_substitute.h90"18 #include "vectopt_loop_substitute.h90" -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trc.F90
r2082 r2104 4 4 !! Passive tracers : module for tracers defined 5 5 !!====================================================================== 6 !! History : -! 1996-01 (M. Levy) Original code6 !! History : OPA ! 1996-01 (M. Levy) Original code 7 7 !! - ! 1999-07 (M. Levy) for LOBSTER1 or NPZD model 8 8 !! - ! 2000-04 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 9 !! 1.0 ! 2004-03 (C. Ethe) Free form and module 10 !!---------------------------------------------------------------------- 11 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 12 !! $Id$ 13 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 9 !! NEMO 1.0 ! 2004-03 (C. Ethe) Free form and module 14 10 !!---------------------------------------------------------------------- 15 11 #if defined key_top … … 38 34 !! passive tracers fields (before,now,after) 39 35 !! -------------------------------------------------- 40 REAL(wp), PUBLIC :: trai !: initial total tracer41 REAL(wp), PUBLIC , DIMENSION (jpi,jpj,jpk) :: cvol !: masked grid volume42 REAL(wp), PUBLIC :: areatot !: total volume36 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: cvol !: volume correction -degrad option- 37 REAL(wp), PUBLIC :: trai !: initial total tracer 38 REAL(wp), PUBLIC :: areatot !: total volume 43 39 44 40 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: trn !: traceur concentration for actual time step … … 46 42 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: trb !: traceur concentration for before time step 47 43 48 #if ! defined key_zco49 44 !! interpolated gradient 50 45 !!-------------------------------------------------- 51 46 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtru !: horizontal gradient at u-points at bottom ocean level 52 47 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtrv !: horizontal gradient at v-points at bottom ocean level 53 #endif54 48 55 49 !! passive tracers restart (input and output) 56 50 !! ------------------------------------------ 57 LOGICAL , PUBLIC :: ln_rsttr !: boolean term for restart i/o for passive tracers (namelist) 58 LOGICAL , PUBLIC :: lrst_trc !: logical to control the trc restart write 59 INTEGER , PUBLIC :: nutwrs !: output FILE for passive tracers restart 60 INTEGER , PUBLIC :: nutrst !: logical unit for restart FILE for passive tracers 61 INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr. 62 CHARACTER(len=50) :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 63 CHARACTER(len=50) :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 51 LOGICAL , PUBLIC :: ln_rsttr !: boolean term for restart i/o for passive tracers (namelist) 52 LOGICAL , PUBLIC :: lrst_trc !: logical to control the trc restart write 53 INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers 54 INTEGER , PUBLIC :: nutwrs !: output FILE for passive tracers restart 55 INTEGER , PUBLIC :: nutrst !: logical unit for restart FILE for passive tracers 56 INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr. 57 CHARACTER(len=50), PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 58 CHARACTER(len=50), PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 64 59 65 60 !! information for outputs … … 70 65 !! additional 2D/3D outputs namelist 71 66 !! -------------------------------------------------- 72 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) :: ctrc2d !: 2d output field name 73 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) :: ctrc2u !: 2d output field unit 74 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) :: ctrc3d !: 3d output field name 75 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) :: ctrc3u !: 3d output field unit 76 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) :: ctrc2l !: 2d output field long name 77 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) :: ctrc3l !: 3d output field long name 67 INTEGER , PUBLIC :: nwritedia !: frequency of additional arrays outputs(namelist) 68 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) :: ctrc2d !: 2d output field name 69 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) :: ctrc2u !: 2d output field unit 70 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) :: ctrc3d !: 3d output field name 71 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) :: ctrc3u !: 3d output field unit 72 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) :: ctrc2l !: 2d output field long name 73 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) :: ctrc3l !: 3d output field long name 78 74 79 REAL(wp), PUBLIC, DIMENSION (jpi,jpj, jpdia2d) :: trc2d !: additional 2d outputs80 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) :: trc3d !: additional 3d outputs75 REAL(wp), PUBLIC, DIMENSION (jpi,jpj, jpdia2d) :: trc2d !: additional 2d outputs 76 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) :: trc3d !: additional 3d outputs 81 77 82 INTEGER , PUBLIC :: nwritedia !: frequency of additional arrays outputs(namelist)83 78 # endif 84 79 85 80 #if defined key_diabio || defined key_trdmld_trc 86 CHARACTER(len=8), DIMENSION(jpdiabio) :: ctrbio !: biological trends name (NAMELIST) 87 CHARACTER(len=20), DIMENSION(jpdiabio) :: ctrbiu !: biological trends unit (NAMELIST) 88 CHARACTER(len=80), DIMENSION(jpdiabio) :: ctrbil !: biological trends long name (NAMELIST) 89 INTEGER :: nwritebio !: time step frequency for biological outputs (NAMELIST) 81 ! !!* namtop_XXX namelist * 82 INTEGER , PUBLIC :: nwritebio !: time step frequency for biological outputs 83 CHARACTER(len=8 ), PUBLIC, DIMENSION(jpdiabio) :: ctrbio !: biological trends name 84 CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) :: ctrbiu !: biological trends unit 85 CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) :: ctrbil !: biological trends long name 90 86 #endif 91 87 # if defined key_diabio 92 88 !! Biological trends 93 89 !! ----------------- 94 REAL(wp), DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio !: biological trends90 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jpdiabio) :: trbio !: biological trends 95 91 # endif 96 92 … … 108 104 #endif 109 105 106 !!---------------------------------------------------------------------- 107 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 108 !! $Id$ 109 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 110 110 !!====================================================================== 111 111 END MODULE trc -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcdia.F90
r2038 r2104 4 4 !! TOP : Output of passive tracers 5 5 !!====================================================================== 6 !! History : -! 1995-01 (M. Levy) Original code6 !! History : OPA ! 1995-01 (M. Levy) Original code 7 7 !! - ! 1998-01 (C. Levy) NETCDF format using ioipsl interface 8 8 !! - ! 1999-01 (M.A. Foujols) adapted for passive tracer 9 9 !! - ! 1999-09 (M.A. Foujols) split into three parts 10 !! 10 !! NEMO 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 11 11 !! ! 2008-05 (C. Ethe re-organization) 12 12 !!---------------------------------------------------------------------- … … 32 32 PRIVATE 33 33 34 PUBLIC trc_dia34 PUBLIC trc_dia ! called by XXX module 35 35 36 36 INTEGER :: nit5 !: id for tracer output file … … 56 56 # include "top_substitute.h90" 57 57 !!---------------------------------------------------------------------- 58 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)58 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 59 59 !! $Id$ 60 60 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 61 61 !!---------------------------------------------------------------------- 62 63 62 CONTAINS 64 63 … … 72 71 INTEGER :: kindic 73 72 !!--------------------------------------------------------------------- 74 73 ! 75 74 CALL trcdit_wr( kt, kindic ) ! outputs for tracer concentration 76 75 CALL trcdii_wr( kt, kindic ) ! outputs for additional arrays 77 76 CALL trcdib_wr( kt, kindic ) ! outputs for biological trends 78 79 77 ! 80 78 END SUBROUTINE trc_dia 79 81 80 82 81 SUBROUTINE trcdit_wr( kt, kindic ) … … 108 107 CHARACTER (len=80) :: cltral 109 108 REAL(wp) :: zsto, zout, zdt 110 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 109 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 111 110 !!---------------------------------------------------------------------- 112 111 … … 138 137 139 138 ! define time axis 140 itmod = kt - nit trc000 + 1139 itmod = kt - nit000 + 1 141 140 it = kt 141 iiter = ( nit000 - 1 ) / nn_dttrc 142 142 143 143 ! Define NETCDF files and fields at beginning of first time step … … 146 146 IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 147 147 148 IF( kt == nit trc000 ) THEN148 IF( kt == nit000 ) THEN 149 149 150 150 ! Compute julian date from starting date of the run … … 152 152 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 153 153 IF(lwp)WRITE(numout,*)' ' 154 IF(lwp)WRITE(numout,*)' Date 0 used :', nit trc000 &154 IF(lwp)WRITE(numout,*)' Date 0 used :', nit000 & 155 155 & ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday & 156 156 & ,'Julian day : ', zjulian … … 176 176 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 177 177 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 178 & nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom)178 & iiter, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 179 179 180 180 ! Vertical grid for tracer : gdept … … 250 250 CHARACTER (len=80) :: cltral 251 251 INTEGER :: jl 252 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 252 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 253 253 REAL(wp) :: zsto, zout, zdt 254 254 !!---------------------------------------------------------------------- … … 281 281 282 282 ! define time axis 283 itmod = kt - nit trc000 + 1283 itmod = kt - nit000 + 1 284 284 it = kt 285 iiter = ( nit000 - 1 ) / nn_dttrc 285 286 286 287 ! 1. Define NETCDF files and fields at beginning of first time step … … 289 290 IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 290 291 291 IF( kt == nit trc000 ) THEN292 IF( kt == nit000 ) THEN 292 293 293 294 ! Define the NETCDF files for additional arrays : 2D or 3D … … 302 303 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 303 304 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 304 & nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom )305 & iiter, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 305 306 306 307 ! Vertical grid for 2d and 3d arrays … … 367 368 368 369 # else 369 370 370 SUBROUTINE trcdii_wr( kt, kindic ) ! Dummy routine 371 371 INTEGER, INTENT ( in ) :: kt, kindic 372 372 END SUBROUTINE trcdii_wr 373 374 373 # endif 375 374 … … 392 391 !! IF kindic >0, output of fields before the time step loop 393 392 !!---------------------------------------------------------------------- 394 !!395 393 INTEGER, INTENT( in ) :: kt ! ocean time-step 396 394 INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination … … 401 399 CHARACTER (len=80) :: cltral 402 400 INTEGER :: ji, jj, jk, jl 403 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 401 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod, iiter 404 402 REAL(wp) :: zsto, zout, zdt 405 403 !!---------------------------------------------------------------------- … … 433 431 434 432 ! define time axis 435 itmod = kt - nit trc000 + 1433 itmod = kt - nit000 + 1 436 434 it = kt 435 iiter = ( nit000 - 1 ) / nn_dttrc 437 436 438 437 ! Define NETCDF files and fields at beginning of first time step … … 441 440 IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 442 441 443 IF( kt == nit trc000 ) THEN442 IF( kt == nit000 ) THEN 444 443 445 444 ! Define the NETCDF files for biological trends … … 450 449 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 451 450 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 452 & nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom )451 & iiter, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 453 452 ! Vertical grid for biological trends 454 453 CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) … … 510 509 INTEGER, INTENT(in) :: kt 511 510 END SUBROUTINE trc_dia 512 513 511 #endif 514 512 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcdta.F90
r1953 r2104 36 36 # include "top_substitute.h90" 37 37 !!---------------------------------------------------------------------- 38 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)38 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 39 39 !! $Id$ 40 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 43 42 CONTAINS 44 43 45 !!----------------------------------------------------------------------46 !! Default case NetCDF file47 !!----------------------------------------------------------------------48 49 44 SUBROUTINE trc_dta( kt ) 50 45 !!---------------------------------------------------------------------- … … 63 58 !! 64 59 CHARACTER (len=39) :: clname(jptra) 65 INTEGER, PARAMETER :: & 66 jpmonth = 12 ! number of months 60 INTEGER, PARAMETER :: jpmonth = 12 ! number of months 67 61 INTEGER :: ji, jj, jn, jl 68 62 INTEGER :: imois, iman, i15, ik ! temporary integers 69 63 REAL(wp) :: zxy, zl 64 !!gm HERE the daymod should be used instead of computation of month and co !! 65 !!gm better in case of real calandar and leap-years ! 70 66 !!---------------------------------------------------------------------- 71 67 … … 74 70 IF( lutini(jn) ) THEN 75 71 76 IF ( kt == nit trc000 ) THEN72 IF ( kt == nit000 ) THEN 77 73 !! 3D tracer data 78 74 IF(lwp)WRITE(numout,*) … … 92 88 ! -------------------- 93 89 94 IF ( kt == nit trc000 .AND. nlectr(jn) == 0 ) THEN90 IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN 95 91 ntrc1(jn) = 0 96 92 IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' … … 107 103 # if defined key_pisces 108 104 ! Read montly file 109 IF( ( kt == nit trc000 .AND. nlectr(jn) == 0) .OR. imois /= ntrc1(jn) ) THEN105 IF( ( kt == nit000 .AND. nlectr(jn) == 0) .OR. imois /= ntrc1(jn) ) THEN 110 106 nlectr(jn) = 1 111 107 … … 189 185 # else 190 186 ! Read init file only 191 IF( kt == nit trc000 ) THEN187 IF( kt == nit000 ) THEN 192 188 ntrc1(jn) = 1 193 189 CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) … … 196 192 ENDIF 197 193 # endif 198 199 194 ENDIF 200 195 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcini.F90
r2087 r2104 41 41 !! * Substitutions 42 42 # include "domzgr_substitute.h90" 43 !!----------------------------------------------------------------------44 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)45 !! $Id$46 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)47 !!----------------------------------------------------------------------48 43 49 44 CONTAINS … … 123 118 # if defined key_dtatrc 124 119 ! Initialization of tracer from a file that may also be used for damping 125 CALL trc_dta( nit trc000 )120 CALL trc_dta( nit000 ) 126 121 DO jn = 1, jptra 127 122 IF( lutini(jn) ) trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) ! initialisation from file if required … … 138 133 139 134 IF( ln_zps .AND. .NOT. lk_trc_c1d ) & ! Partial steps: before horizontal gradient of passive 140 & CALL zps_hde( nit trc000, jptra, trb, gtru, gtrv ) ! tracers at the bottom ocean level135 & CALL zps_hde( nit000, jptra, trb, gtru, gtrv ) ! tracers at the bottom ocean level 141 136 142 137 … … 181 176 #endif 182 177 178 !!---------------------------------------------------------------------- 179 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 180 !! $Id$ 181 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 183 182 !!====================================================================== 184 183 END MODULE trcini -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcnam.F90
r2038 r2104 102 102 READ ( numnat, namtrc ) 103 103 104 !!Chris computes the first time step of tracer model105 nittrc000 = nit000 + nn_dttrc - 1106 107 104 DO jn = 1, jptra 108 105 ctrcnm(jn) = sn_tracer(jn)%clsname … … 118 115 WRITE(numout,*) ' Namelist : namtrc' 119 116 WRITE(numout,*) ' time step freq. for pass. trac. nn_dttrc = ', nn_dttrc 120 WRITE(numout,*) ' 1st time step for pass. trac. nittrc000 = ', nittrc000121 117 WRITE(numout,*) ' frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc 122 118 WRITE(numout,*) ' restart LOGICAL for passive tr. ln_rsttr = ', ln_rsttr … … 200 196 #endif 201 197 198 !!---------------------------------------------------------------------- 199 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 200 !! $Id: $ 201 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 202 202 !!====================================================================== 203 203 END MODULE trcnam -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcrst.F90
r2038 r2104 47 47 !! * Substitutions 48 48 # include "top_substitute.h90" 49 !!----------------------------------------------------------------------50 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)51 !! $Id$52 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)53 !!----------------------------------------------------------------------54 49 55 50 CONTAINS … … 128 123 ! Time domain : restart 129 124 ! --------------------- 130 CALL trc_rst_cal( nit trc000, 'READ' ) ! calendar125 CALL trc_rst_cal( nit000, 'READ' ) ! calendar 131 126 132 127 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ; iarak0 = 1 … … 222 217 !! 223 218 !! According to namelist parameter nrstdt, 224 !! nn_rsttr = 0 no control on the date (nit trc000 is arbitrary).219 !! nn_rsttr = 0 no control on the date (nit000 is arbitrary). 225 220 !! nn_rsttr = 1 we verify that nit000 is equal to the last 226 221 !! time step of previous run + 1. … … 251 246 WRITE(numout,*) ' *** restart option' 252 247 SELECT CASE ( nn_rsttr ) 253 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nit trc000'248 CASE ( 0 ) ; WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000' 254 249 CASE ( 1 ) ; WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 255 250 CASE ( 2 ) ; WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' … … 258 253 ENDIF 259 254 ! Control of date 260 IF( nit trc000 - NINT( zkt ) /= 1 .AND. nn_rsttr /= 0 ) &255 IF( nit000 - NINT( zkt ) /= 1 .AND. nn_rsttr /= 0 ) & 261 256 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 262 257 & ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) … … 269 264 ELSE 270 265 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam 271 adatrj = ( REAL( nit trc000-1, wp ) * rdttra(1) ) / rday266 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 272 267 ! note this is wrong if time step has changed during run 273 268 ENDIF … … 369 364 #endif 370 365 366 !!---------------------------------------------------------------------- 367 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 368 !! $Id$ 369 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 371 370 !!====================================================================== 372 371 END MODULE trcrst -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcsms.F90
r2038 r2104 28 28 29 29 !!---------------------------------------------------------------------- 30 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)30 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 31 31 !! $Id$ 32 32 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcstp.F90
r2038 r2104 4 4 !! Time-stepping : time loop of opa for passive tracer 5 5 !!====================================================================== 6 !! History : 1.0 ! 2004-03 (C. Ethe) Original 7 !!---------------------------------------------------------------------- 6 8 #if defined key_top 7 9 !!---------------------------------------------------------------------- 8 10 !! trc_stp : passive tracer system time-stepping 9 11 !!---------------------------------------------------------------------- 10 !! * Modules used11 12 USE oce_trc ! ocean dynamics and active tracers variables 12 13 USE trc … … 25 26 PRIVATE 26 27 27 !! * Routine accessibility28 PUBLIC trc_stp ! called by step28 PUBLIC trc_stp ! called by step 29 29 30 !!---------------------------------------------------------------------- 30 !! TOP 1.0 , LOCEAN-IPSL (2005)31 !! $Id: trcstp.F90 1285 2009-02-03 13:38:51Z cetlod$32 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt31 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 32 !! $Id: $ 33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 33 34 !!---------------------------------------------------------------------- 34 35 35 CONTAINS 36 36 … … 44 44 !! Compute the passive tracers trends 45 45 !! Update the passive tracers 46 !!47 !! History :48 !! 9.0 ! 04-03 (C. Ethe) Original49 46 !!------------------------------------------------------------------- 50 !! * Arguments51 47 INTEGER, INTENT( in ) :: kt ! ocean time-step index 52 48 CHARACTER (len=25) :: charout 49 !!------------------------------------------------------------------- 53 50 54 ! this ROUTINE is called only every nn_dttrc time step 55 IF( MOD( kt , nn_dttrc ) /= 0 ) RETURN 56 57 IF(ln_ctl) THEN 58 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 59 CALL prt_ctl_trc_info(charout) 51 IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN ! only every nn_dttrc time step 52 ! 53 IF(ln_ctl) THEN 54 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 55 CALL prt_ctl_trc_info(charout) 56 ENDIF 57 ! 58 tra(:,:,:,:) = 0.e0 59 ! 60 IF( kt == nit000 .AND. lk_trdmld_trc ) & 61 & CALL trd_mld_trc_init ! trends: Mixed-layer 62 CALL trc_rst_opn( kt ) ! Open tracer restart file 63 IF( lk_iomput ) THEN ; CALL trc_wri( kt ) ! output of passive tracers 64 ELSE ; CALL trc_dia( kt ) 65 ENDIF 66 CALL trc_sms( kt ) ! tracers: sink and source 67 CALL trc_trp( kt ) ! transport of passive tracers 68 IF( kt == nit000 ) CALL iom_close( numrtr ) ! close input passive tracers restart file 69 IF( lrst_trc ) CALL trc_rst_wri( kt ) ! write tracer restart file 70 IF( lk_trdmld_trc ) CALL trd_mld_trc( kt ) ! trends: Mixed-layer 71 ! 60 72 ENDIF 61 62 tra(:,:,:,:) = 0.63 64 IF( kt == nittrc000 .AND. lk_trdmld_trc ) &65 & CALL trd_mld_trc_init ! trends: Mixed-layer66 CALL trc_rst_opn( kt ) ! Open tracer restart file67 CALL trc_sms( kt ) ! tracers: sink and source68 CALL trc_trp( kt ) ! transport of passive tracers69 IF( kt == nittrc000 ) CALL iom_close( numrtr ) ! close input passive tracers restart file70 IF( lrst_trc ) CALL trc_rst_wri( kt ) ! write tracer restart file71 IF( lk_iomput ) THEN72 CALL trc_wri( kt ) ! output of passive tracers73 ELSE74 CALL trc_dia( kt ) ! diagnostics75 ENDIF76 IF( lk_trdmld_trc ) CALL trd_mld_trc( kt ) ! trends: Mixed-layer77 73 78 74 END SUBROUTINE trc_stp … … 84 80 CONTAINS 85 81 SUBROUTINE trc_stp( kt ) ! Empty routine 86 INTEGER, INTENT(in) :: kt87 82 WRITE(*,*) 'trc_stp: You should not have seen this print! error?', kt 88 83 END SUBROUTINE trc_stp -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcwri.F90
r2038 r2104 28 28 !! * Substitutions 29 29 # include "top_substitute.h90" 30 !!----------------------------------------------------------------------31 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)32 !! $Id: trcdia.F90 1450 2009-05-15 14:12:12Z cetlod $33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)34 !!----------------------------------------------------------------------35 30 36 31 CONTAINS … … 68 63 69 64 #if defined key_offline 70 IF( kt == nit trc000 ) THEN65 IF( kt == nit000 ) THEN 71 66 ! WRITE root name in date.file for use by postpro 72 67 IF(lwp) THEN … … 98 93 #endif 99 94 95 !!---------------------------------------------------------------------- 96 !! NEMO/TOP 3.3 , LOCEAN-IPSL (2010) 97 !! $Id: $ 98 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 100 99 !!====================================================================== 101 100 END MODULE trcwri
Note: See TracChangeset
for help on using the changeset viewer.