Changeset 945
- Timestamp:
- 2008-05-14T18:14:53+02:00 (16 years ago)
- Location:
- trunk/NEMO/TOP_SRC
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/TOP_SRC/initrc.F90
r793 r945 1 1 MODULE initrc 2 !!================================================ 3 !! 4 !! *** MODULE initrc *** 5 !! Initialisation the tracer model 6 !!================================================ 7 8 #if defined key_passivetrc 9 10 !!------------------------------------------------------- 11 !! TOP 1.0, LOCEAN-IPSL (2005) 12 !! $Header$ 13 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 14 !!------------------------------------------------------- 15 16 !!-------------------------------------------------------------- 17 !! * Modules used 18 !! ============== 2 !!====================================================================== 3 !! *** MODULE initrc *** 4 !! TOP : Initialisation of passive tracers 5 !!====================================================================== 6 !! History : - ! 1991-03 () original code 7 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 8 !! - ! 2005-10 (C. Ethe) print control 9 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 10 !!---------------------------------------------------------------------- 11 #if defined key_top 12 !!---------------------------------------------------------------------- 13 !! 'key_top' TOP models 14 !!---------------------------------------------------------------------- 15 !! ini_trc : initialisation of passive tracers 16 !!---------------------------------------------------------------------- 19 17 USE oce_trc 20 18 USE trc … … 25 23 USE trcini 26 24 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) 27 USE lib_mpp ! distributed memory computing28 25 29 26 IMPLICIT NONE 30 27 PRIVATE 31 28 32 33 !! * Accessibility 34 PUBLIC ini_trc 29 PUBLIC ini_trc ! called by ??? 35 30 36 31 !! * Substitutions 37 32 # include "domzgr_substitute.h90" 33 !!---------------------------------------------------------------------- 34 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 35 !! $Id$ 36 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 37 !!---------------------------------------------------------------------- 38 38 39 39 CONTAINS … … 41 41 SUBROUTINE ini_trc 42 42 !!--------------------------------------------------------------------- 43 !! *** ROUTINE ini_trc *** 43 44 !! 44 !! ROUTINE ini_trc 45 !! ****************** 45 !! ** Purpose : Initialization of the passive tracer fields 46 46 !! 47 !! PURPOSE : 48 !! --------- 49 !! initialize the tracer model 50 !! 51 !! METHOD : 52 !! ------- 53 !! 54 !! 55 !! History: 56 !! ------- 57 !! original : 91-03 () 58 !! additions : 92-01 (C. Levy) 59 !! 05-03 (O. Aumont and A. El Moussaoui) F90 60 !! 05-10 (C. Ethe ) print control initialization 61 !!---------------------------------------------------------------------- 47 !! ** Method : - read namelist 48 !! - control the consistancy 49 !! - compute specific initialisations 50 !! - set initial tracer fields (either read restart 51 !! or read data or analytical formulation 52 !!--------------------------------------------------------------------- 53 INTEGER :: jk, jn ! dummy loop indices 54 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbt ! workspace: masked grid volume 55 CHARACTER (len=25) :: charout 62 56 63 57 !!--------------------------------------------------------------------- 64 !! OPA.9, 03-200565 !!---------------------------------------------------------------------66 INTEGER :: ji, jj, jk, jn !: dummy loop indices67 58 68 !! 0.b PRINT the number of tracer 69 !! ------------------------------ 59 IF(lwp) WRITE(numout,*) 60 IF(lwp) WRITE(numout,*) 'ini_trc : initial set up of the passive tracers' 61 IF(lwp) WRITE(numout,*) '~~~~~~~' 70 62 71 IF(lwp) WRITE(numout,*) ' ' 72 IF(lwp) WRITE(numout,*) ' *** number of passive tracer jptra = ',jptra 73 IF(lwp) WRITE(numout,*) ' ' 63 ! ! masked grid volume 64 DO jk = 1, jpk 65 zbt(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:) 66 END DO 67 #if defined key_off_degrad 68 DO jk = 1, jpk 69 zbt(:,:,:) = zbt(:,:,:) * facvol(:,:,jk) ! degrad option: reduction by facvol 70 ENDDO 71 #endif 74 72 75 ! 1. READ passive tracers namelists 76 ! --------------------------------- 73 ! ! total volume of the ocean 74 areatot = SUM( zbt(:,:,:) ) 75 IF( lk_mpp ) CALL mpp_sum( areatot ) ! sum over the global domain 77 76 78 CALL trc_lec 77 CALL trc_lec ! READ passive tracers namelists 79 78 80 ! 2. control consistency between parameters, cpp key and namelists 81 ! ---------------------------------------------------------------- 79 CALL trc_ctl ! control consistency between parameters, cpp key and namelists 82 80 83 CALL trc_ ctl81 CALL trc_ini ! computes some initializations 84 82 85 ! 3. computes some initializations 86 ! -------------------------------- 87 88 CALL trc_ini 89 90 91 ! 4. total volume of the ocean 92 !----------------------------- 93 94 areatot = 0. 95 DO jk = 1, jpk 96 DO jj = 1, jpj 97 DO ji = 1, jpi 98 areatot = areatot + tmask(ji,jj,jk) * tmask_i(ji,jj) & 99 #if defined key_off_degrad 100 & * facvol(ji,jj,jk) & 101 #endif 102 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 103 END DO 104 END DO 105 END DO 106 IF( lk_mpp ) THEN 107 CALL mpp_sum(areatot) ! sum over the global domain 108 END IF 109 110 IF(lwp) WRITE(numout,*) ' ' 111 IF (lwp) WRITE(numout,*) 'Total volume of ocean =',areatot 112 IF(lwp) WRITE(numout,*) ' ' 113 114 ! 5. Initialization of tracers 115 ! ----------------------------- 116 117 IF( lrsttr ) THEN 118 119 ! 5.1 restart from a file 120 !------------------------ 121 CALL trc_rst_read 122 123 ELSE 124 125 ! 5.2 analytical formulation or global data 126 !------------------------------------- 127 CALL trc_dtr 128 83 ! ! set initial tracer values 84 IF( lrsttr ) THEN ; CALL trc_rst_read ! restart from a file 85 ELSE ; CALL trc_dtr ! analytical formulation or from data 129 86 ENDIF 130 87 88 ! ! Computation content of all tracers 89 trai = 0.e0 90 DO jn = 1, jptra 91 trai = trai + SUM( trn(:,:,:,jn) * zbt(:,:,:) ) 92 END DO 93 IF( lk_mpp ) CALL mpp_sum( trai ) ! sum over the global domain 131 94 132 ! 6. Computation integral of all tracers133 !------------------134 95 135 trai = 0. 136 DO jn = 1, jptra 137 DO jk = 1, jpk 138 DO jj = 1, jpj 139 DO ji = 1, jpi 140 trai = trai + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 141 #if defined key_off_degrad 142 & * facvol(ji,jj,jk) & 143 #endif 96 ! ! control print 97 IF(lwp) WRITE(numout,*) ' *** Total number of passive tracer jptra = ', jptra 98 IF(lwp) WRITE(numout,*) ' *** Total volume of ocean = ', areatot 99 IF(lwp) WRITE(numout,*) ' *** Total inital content of all tracers = ', trai 100 IF(lwp) WRITE(numout,*) 144 101 145 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 146 END DO 147 END DO 148 END DO 149 ENDDO 150 151 IF( lk_mpp ) THEN 152 CALL mpp_sum(trai) ! sum over the global domain 153 END IF 102 IF( ln_ctl ) CALL prt_ctl_trc_init ! control print 103 ! 154 104 155 IF(lwp) WRITE(numout,*) ' ' 156 IF(lwp) WRITE(numout,*) 'Integral of all tracers over the full domain at initial time =',trai 157 IF(lwp) WRITE(numout,*) ' ' 158 159 ! 6. Print control 160 !------------------ 161 162 IF( ln_ctl ) CALL prt_ctl_trc_init 105 IF(ln_ctl) THEN ! print mean trends (used for debugging) 106 WRITE(charout, FMT="('ini ')") 107 CALL prt_ctl_trc_info( charout ) 108 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 109 ENDIF 163 110 164 111 END SUBROUTINE ini_trc 165 112 166 167 113 #else 168 !! ======================================================================169 !! Empty module : No passive tracer170 !! ======================================================================114 !!---------------------------------------------------------------------- 115 !! Empty module : No passive tracer 116 !!---------------------------------------------------------------------- 171 117 CONTAINS 172 SUBROUTINE ini_trc 118 SUBROUTINE ini_trc ! Dummy routine 173 119 END SUBROUTINE ini_trc 174 120 #endif 175 121 122 !!====================================================================== 176 123 END MODULE initrc -
trunk/NEMO/TOP_SRC/oce_trc.F90
r910 r945 2 2 !!====================================================================== 3 3 !! *** MODULE oce_trc *** 4 !! Ocean passive tracer : share ocean-passive tracers variables4 !! TOP : variables shared between ocean and passive tracers 5 5 !!====================================================================== 6 !! History : 7 !! 9.0 ! 04-03 (C. Ethe) F90: Free form and module 8 !!---------------------------------------------------------------------- 9 !! TOP 1.0, LOCEAN-IPSL (2005) 10 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/oce_trc.F90,v 1.17 2007/05/28 02:55:05 opalod Exp $ 11 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 12 !!---------------------------------------------------------------------- 13 !! * Modules used 14 !! Domain characteristics 15 USE par_oce , ONLY : & 16 cp_cfg => cp_cfg, & !: name of the configuration 17 jp_cfg => jp_cfg, & !: resolution of the configuration 18 jpiglo => jpiglo, & !: first dimension of global domain --> i 19 jpjglo => jpjglo, & !: second dimension of global domain --> j 20 jpi => jpi , & !: first dimension of grid --> i 21 jpj => jpj , & !: second dimension of grid --> j 22 jpk => jpk , & !: number of levels 23 jpim1 => jpim1 , & !: jpi - 1 24 jpjm1 => jpjm1 , & !: jpj - 1 25 jpkm1 => jpkm1 , & !: jpk - 1 26 jpij => jpij , & !: jpi x jpj 27 jpidta => jpidta, & !: first horizontal dimension > or = jpi 28 jpjdta => jpjdta, & !: second horizontal dimension > or = jpj 29 jpkdta => jpkdta, & !: number of levels > or = jpk 30 lk_esopa => lk_esopa !: flag to activate the all option 31 32 33 !! run controm 34 35 USE in_out_manager 36 37 USE dom_oce , ONLY : & 38 lzoom => lzoom , & !: zoom flag 39 lzoom_e => lzoom_e , & !: East zoom type flag 40 lzoom_w => lzoom_w , & !: West zoom type flag 41 lzoom_s => lzoom_s , & !: South zoom type flag 42 lzoom_n => lzoom_n , & !: North zoom type flag 43 lzoom_arct => lzoom_arct, & !: ORCA arctic zoom flag 44 lzoom_anta => lzoom_anta !: ORCA antarctic zoom flag 45 46 47 48 USE dom_oce , ONLY : & 49 nperio => nperio, & !: type of lateral boundary condition 50 nimpp => nimpp , & !: i index for mpp-subdomain left bottom 51 njmpp => njmpp , & !: j index for mpp-subdomain left bottom 52 nproc => nproc , & !: number for local processor 53 narea => narea , & !: number for local area 54 mig => mig , & !: local ==> global domain i-indice 55 mjg => mjg , & !: local ==> global domain i-indice 56 mi0 => mi0 , & !: global ==> local domain i-indice 57 mi1 => mi1 , & !: (mi0=1 and mi1=0 if the global indice is not in the local domain) 58 mj0 => mj0 , & !: global ==> local domain j-indice 59 mj1 => mj1 , & !: (mj0=1 and mj1=0 if the global indice is not in the local domain) 60 nidom => nidom 6 !! History : 1.0 ! 2004-03 (C. Ethe) original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) rewritting 8 !!---------------------------------------------------------------------- 9 !! NEMO/TOP 2.0, LOCEAN-IPSL (2007) 10 !! $Header: $ 11 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 12 !!---------------------------------------------------------------------- 13 #if defined key_top 14 !!---------------------------------------------------------------------- 15 !! 'key_top' TOP models 16 !!---------------------------------------------------------------------- 17 18 !* Domain size * 19 USE par_oce , ONLY : cp_cfg => cp_cfg !: name of the configuration 20 USE par_oce , ONLY : jp_cfg => jp_cfg !: resolution of the configuration 21 USE par_oce , ONLY : jpiglo => jpiglo !: first dimension of global domain --> i 22 USE par_oce , ONLY : jpjglo => jpjglo !: second dimension of global domain --> j 23 USE par_oce , ONLY : jpi => jpi !: first dimension of grid --> i 24 USE par_oce , ONLY : jpj => jpj !: second dimension of grid --> j 25 USE par_oce , ONLY : jpk => jpk !: number of levels 26 USE par_oce , ONLY : jpim1 => jpim1 !: jpi - 1 27 USE par_oce , ONLY : jpjm1 => jpjm1 !: jpj - 1 28 USE par_oce , ONLY : jpkm1 => jpkm1 !: jpk - 1 29 USE par_oce , ONLY : jpij => jpij !: jpi x jpj 30 USE par_oce , ONLY : jpidta => jpidta !: first horizontal dimension > or = jpi 31 USE par_oce , ONLY : jpjdta => jpjdta !: second horizontal dimension > or = jpj 32 USE par_oce , ONLY : jpkdta => jpkdta !: number of levels > or = jpk 33 USE par_oce , ONLY : lk_esopa => lk_esopa !: flag to activate the all option 34 35 !* IO manager * 36 USE in_out_manager ! use all the variables 37 !* physical constants * 38 USE phycst ! use all the variables 39 40 !* model domain * 41 USE dom_oce , ONLY : lzoom => lzoom !: zoom flag 42 USE dom_oce , ONLY : lzoom_e => lzoom_e !: East zoom type flag 43 USE dom_oce , ONLY : lzoom_w => lzoom_w !: West zoom type flag 44 USE dom_oce , ONLY : lzoom_s => lzoom_s !: South zoom type flag 45 USE dom_oce , ONLY : lzoom_n => lzoom_n !: North zoom type flag 46 USE dom_oce , ONLY : lzoom_arct => lzoom_arct !: ORCA arctic zoom flag 47 USE dom_oce , ONLY : lzoom_anta => lzoom_anta !: ORCA antarctic zoom flag 48 USE dom_oce , ONLY : nperio => nperio !: type of lateral boundary condition 49 USE dom_oce , ONLY : nimpp => nimpp !: i index for mpp-subdomain left bottom 50 USE dom_oce , ONLY : njmpp => njmpp !: j index for mpp-subdomain left bottom 51 USE dom_oce , ONLY : nproc => nproc !: number for local processor 52 USE dom_oce , ONLY : narea => narea !: number for local area 53 USE dom_oce , ONLY : mig => mig !: local ==> global domain i-indice 54 USE dom_oce , ONLY : mjg => mjg !: local ==> global domain i-indice 55 USE dom_oce , ONLY : mi0 => mi0 !: global ==> local domain i-indice 56 USE dom_oce , ONLY : mi1 => mi1 !: (mi0=1 and mi1=0 if the global indice is not in the local one) 57 USE dom_oce , ONLY : mj0 => mj0 !: global ==> local domain j-indice 58 USE dom_oce , ONLY : mj1 => mj1 !: (mj0=1 and mj1=0 if the global indice is not in the local one) 59 USE dom_oce , ONLY : nidom => nidom 60 USE dom_oce , ONLY : nimppt => nimppt !:i-indexes for each processor 61 USE dom_oce , ONLY : njmppt => njmppt !:j-indexes for each processor 62 USE dom_oce , ONLY : ibonit => ibonit !:i-processor neighbour existence 63 USE dom_oce , ONLY : ibonjt => ibonjt !:j- processor neighbour existence 64 USE dom_oce , ONLY : nlci => nlci !:i- & j-dimensions of the local subdomain 65 USE dom_oce , ONLY : nlcj => nlcj !: 66 USE dom_oce , ONLY : nldi => nldi !:first and last indoor i- and j-indexes 67 USE dom_oce , ONLY : nlei => nlei !: 68 USE dom_oce , ONLY : nldj => nldj !: 69 USE dom_oce , ONLY : nlej => nlej !: 70 USE dom_oce , ONLY : nlcit => nlcit !:dimensions of every i-subdomain 71 USE dom_oce , ONLY : nlcjt => nlcjt !:dimensions of every j-subdomain 72 USE dom_oce , ONLY : nldit => nldit !:first indoor index for each i-domain 73 USE dom_oce , ONLY : nleit => nleit !:last indoor index for each i-domain 74 USE dom_oce , ONLY : nldjt => nldjt !:first indoor index for each j-domain 75 USE dom_oce , ONLY : nlejt => nlejt !:last indoor index for each j-domain 61 76 62 USE dom_oce , ONLY : & 63 nimppt => nimppt , & !:i-indexes for each processor 64 njmppt => njmppt , & !:j-indexes for each processor 65 ibonit => ibonit , & !:i-processor neighbour existence 66 ibonjt => ibonjt , & !:j- processor neighbour existence 67 nlci => nlci , & !:i- & j-dimensions of the local subdomain 68 nlcj => nlcj , & !: 69 nldi => nldi , & !:first and last indoor i- and j-indexes 70 nlei => nlei , & !: 71 nldj => nldj , & !: 72 nlej => nlej , & !: 73 nlcit => nlcit , & !:dimensions of every i-subdomain 74 nlcjt => nlcjt , & !:dimensions of every j-subdomain 75 nldit => nldit , & !:first indoor index for each i-domain 76 nleit => nleit , & !:last indoor index for each i-domain 77 nldjt => nldjt , & !:first indoor index for each j-domain 78 nlejt => nlejt !:last indoor index for each j-domain 79 80 81 !! horizontal curvilinear coordinate and scale factors 82 USE dom_oce , ONLY : & 83 glamt => glamt , & !: longitude of t-point (degre) 84 glamu => glamu , & !: longitude of t-point (degre) 85 glamv => glamv , & !: longitude of t-point (degre) 86 glamf => glamf , & !: longitude of t-point (degre) 87 gphit => gphit , & !: latitude of t-point (degre) 88 gphiu => gphiu , & !: latitude of t-point (degre) 89 gphiv => gphiv , & !: latitude of t-point (degre) 90 gphif => gphif , & !: latitude of t-point (degre) 91 e1t => e1t , & !: horizontal scale factors at t-point (m) 92 e2t => e2t , & !: horizontal scale factors at t-point (m) 93 e1u => e1u , & !: horizontal scale factors at u-point (m) 94 e2u => e2u , & !: horizontal scale factors at u-point (m) 95 e1v => e1v , & !: horizontal scale factors at v-point (m) 96 e2v => e2v !: horizontal scale factors at v-point (m) 97 98 !! vertical coordinate and scale factors 99 USE dom_oce , ONLY : & 100 gdept_0 => gdept_0 , & !: reference depth of t-points (m) 101 e3t_0 => e3t_0 , & !: reference depth of t-points (m) 102 e3w_0 => e3w_0 , & !: reference depth of w-points (m) 103 gdepw_0 => gdepw_0 !: reference depth of w-points (m) 104 105 #if ! defined key_zco 106 USE dom_oce , ONLY : & 107 gdep3w => gdep3w , & !: ??? 108 gdept => gdept, & !: depth of t-points (m) 109 gdepw => gdepw, & !: depth of t-points (m) 110 e3t => e3t , & !: vertical scale factors at t- 111 e3u => e3u , & !: vertical scale factors at u- 112 e3v => e3v , & !: vertical scale factors v- 113 e3w => e3w , & !: w-points (m) 114 e3f => e3f , & !: f-points (m) 115 e3uw => e3uw , & !: uw-points (m) 116 e3vw => e3vw !: vw-points (m) 77 !* horizontal mesh * 78 USE dom_oce , ONLY : glamt => glamt !: longitude of t-point (degre) 79 USE dom_oce , ONLY : glamu => glamu !: longitude of t-point (degre) 80 USE dom_oce , ONLY : glamv => glamv !: longitude of t-point (degre) 81 USE dom_oce , ONLY : glamf => glamf !: longitude of t-point (degre) 82 USE dom_oce , ONLY : gphit => gphit !: latitude of t-point (degre) 83 USE dom_oce , ONLY : gphiu => gphiu !: latitude of t-point (degre) 84 USE dom_oce , ONLY : gphiv => gphiv !: latitude of t-point (degre) 85 USE dom_oce , ONLY : gphif => gphif !: latitude of t-point (degre) 86 USE dom_oce , ONLY : e1t => e1t !: horizontal scale factors at t-point (m) 87 USE dom_oce , ONLY : e2t => e2t !: horizontal scale factors at t-point (m) 88 USE dom_oce , ONLY : e1u => e1u !: horizontal scale factors at u-point (m) 89 USE dom_oce , ONLY : e2u => e2u !: horizontal scale factors at u-point (m) 90 USE dom_oce , ONLY : e1v => e1v !: horizontal scale factors at v-point (m) 91 USE dom_oce , ONLY : e2v => e2v !: horizontal scale factors at v-point (m) 92 93 !* vertical mesh * 94 USE dom_oce , ONLY : gdept_0 => gdept_0 !: reference depth of t-points (m) 95 USE dom_oce , ONLY : e3t_0 => e3t_0 !: reference depth of t-points (m) 96 USE dom_oce , ONLY : e3w_0 => e3w_0 !: reference depth of w-points (m) 97 USE dom_oce , ONLY : gdepw_0 => gdepw_0 !: reference depth of w-points (m) 98 # if ! defined key_zco 99 USE dom_oce , ONLY : gdep3w => gdep3w !: ??? 100 USE dom_oce , ONLY : gdept => gdept !: depth of t-points (m) 101 USE dom_oce , ONLY : gdepw => gdepw !: depth of t-points (m) 102 USE dom_oce , ONLY : e3t => e3t !: vertical scale factors at t- 103 USE dom_oce , ONLY : e3u => e3u !: vertical scale factors at u- 104 USE dom_oce , ONLY : e3v => e3v !: vertical scale factors v- 105 USE dom_oce , ONLY : e3w => e3w !: w-points (m) 106 USE dom_oce , ONLY : e3f => e3f !: f-points (m) 107 USE dom_oce , ONLY : e3uw => e3uw !: uw-points (m) 108 USE dom_oce , ONLY : e3vw => e3vw !: vw-points (m) 109 # endif 110 USE dom_oce , ONLY : ln_zps => ln_zps !: partial steps flag 111 USE dom_oce , ONLY : ln_sco => ln_sco !: s-coordinate flag 112 USE dom_oce , ONLY : ln_zco => ln_zco !: z-coordinate flag 113 USE dom_oce , ONLY : lk_zco => lk_zco !: z-coordinate flag (1D or 3D arrays) 114 USE dom_oce , ONLY : hbatt => hbatt !: ocean depth at the vertical of t-point (m) 115 USE dom_oce , ONLY : hbatu => hbatu !: ocean depth at the vertical of u-point (m) 116 USE dom_oce , ONLY : hbatv => hbatv !: ocean depth at the vertical of w-point (m) 117 USE dom_oce , ONLY : gsigt => gsigt !: model level depth coefficient at T-levels 118 USE dom_oce , ONLY : gsigw => gsigw !: model level depth coefficient at W-levels 119 USE dom_oce , ONLY : gsi3w => gsi3w !: model level depth coef at w-levels (defined as the sum of e3w) 120 USE dom_oce , ONLY : esigt => esigt !: vertical scale factor coef. at t-levels 121 USE dom_oce , ONLY : esigw => esigw !: vertical scale factor coef. at w-levels 122 123 !* masks, bathymetry * 124 USE dom_oce , ONLY : mbathy => mbathy !: number of ocean level (=0, & 1, ... , jpk-1) 125 USE dom_oce , ONLY : tmask_i => tmask_i !: Interior mask at t-points 126 USE dom_oce , ONLY : tmask => tmask !: land/ocean mask at t-points 127 USE dom_oce , ONLY : umask => umask !: land/ocean mask at u-points 128 USE dom_oce , ONLY : vmask => vmask !: land/ocean mask at v-points 129 USE dom_oce , ONLY : fmask => fmask !: land/ocean mask at f-points 130 # if defined key_off_degrad 131 USE dom_oce , ONLY : facvol => facvol !: volume factor for degradation 132 # endif 133 134 !* time domain * 135 USE dom_oce , ONLY : neuler => neuler !: restart euler forward option (0=Euler) 136 USE dom_oce , ONLY : rdt => rdt !: time step for the dynamics 137 USE dom_oce , ONLY : atfp => atfp !: asselin time filter parameter 138 USE dom_oce , ONLY : atfp1 => atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 139 USE dom_oce , ONLY : rdttra => rdttra !: vertical profile of tracer time step 140 USE daymod , ONLY : ndastp => ndastp !: time step date in year/month/day aammjj 141 USE daymod , ONLY : nday_year => nday_year !: curent day counted from jan 1st of the current year 142 USE daymod , ONLY : nyear => nyear !: Current year 143 USE daymod , ONLY : nmonth => nmonth !: Current month 144 USE daymod , ONLY : nday => nday !: Current day 145 USE daymod , ONLY : nobis => nobis !: number of days per month 146 147 !* ocean fields: here now and after fields * 148 USE oce , ONLY : ua => ua !: i-horizontal velocity (m s-1) 149 USE oce , ONLY : va => va !: j-horizontal velocity (m s-1) 150 USE oce , ONLY : un => un !: i-horizontal velocity (m s-1) 151 USE oce , ONLY : vn => vn !: j-horizontal velocity (m s-1) 152 USE oce , ONLY : wn => wn !: vertical velocity (m s-1) 153 USE oce , ONLY : tn => tn !: pot. temperature (celsius) 154 USE oce , ONLY : sn => sn !: salinity (psu) 155 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 156 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 157 # if defined key_trc_diatrd 158 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 159 # endif 160 161 162 USE lib_mpp , ONLY : lk_mpp => lk_mpp !: Mpp flag 163 164 USE dynspg_oce , ONLY : lk_dynspg_rl => lk_dynspg_rl !: rigid lid flag 165 166 USE dom_oce , ONLY : n_cla => n_cla !: flag (0/1) for cross land advection 167 168 169 170 !* surface fluxes * 171 USE sbc_oce , ONLY : utau => utau !: i-surface stress component 172 USE sbc_oce , ONLY : vtau => vtau !: j-surface stress component 173 USE sbc_oce , ONLY : qsr => qsr !: penetrative solar radiation (w m-2) 174 USE sbc_oce , ONLY : emp => emp !: evaporation minus precipitation (kg m-2 s-2) 175 USE sbc_oce , ONLY : emps => emps !: evaporation minus precipitation (kg m-2 s-2) 176 USE traqsr , ONLY : xsi1 => xsi1 !: first depth of extinction 177 USE traqsr , ONLY : ln_qsr_sms => ln_qsr_sms !: flag to use or not the biological fluxes for light 178 USE sbcrnf , ONLY : rnfmsk => rnfmsk !: mixed adv scheme in runoffs vicinity (hori.) 179 USE sbcrnf , ONLY : rnfmsk_z => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.) 180 181 !* freezing area * 182 USE ocfzpt , ONLY : freeze => freeze !: ice mask (0 or 1) 183 USE ocfzpt , ONLY : fzptn => fzptn !: now freezing temperature at ocean surface 184 185 !* bottom boundary layer * 186 # if defined key_trabbl_dif || defined key_trabbl_adv 187 USE trabbl , ONLY : atrbbl => atrbbl !: lateral coeff. for bottom boundary layer scheme (m2/s) 188 # if defined key_off_tra 189 USE trabbl, ONLY : bblx => bblx !: ??? 190 USE trabbl, ONLY : bbly => bbly !: ??? 191 # endif 192 # endif 193 194 !* lateral diffusivity (tracers) * 195 USE ldftra_oce , ONLY : aht0 => aht0 !: horizontal eddy diffusivity for tracers (m2/s) 196 USE ldftra_oce , ONLY : ahtb0 => ahtb0 !: background eddy diffusivity for isopycnal diff. (m2/s) 197 USE ldftra_oce , ONLY : ahtu => ahtu !: lateral diffusivity coef. at u-points 198 USE ldftra_oce , ONLY : ahtv => ahtv !: lateral diffusivity coef. at v-points 199 USE ldftra_oce , ONLY : ahtw => ahtw !: lateral diffusivity coef. at w-points 200 USE ldftra_oce , ONLY : ahtt => ahtt !: lateral diffusivity coef. at t-points 201 USE ldftra_oce , ONLY : aeiv0 => aeiv0 !: eddy induced velocity coefficient (m2/s) 202 USE ldftra_oce , ONLY : aeiu => aeiu !: eddy induced velocity coef. at u-points (m2/s) 203 USE ldftra_oce , ONLY : aeiv => aeiv !: eddy induced velocity coef. at v-points (m2/s) 204 USE ldftra_oce , ONLY : aeiw => aeiw !: eddy induced velocity coef. at w-points (m2/s) 205 206 !* vertical diffusion * 207 USE zdf_oce , ONLY : avt => avt !: vert. diffusivity coef. at w-point for temp 208 USE zdf_oce , ONLY : avt0 => avt0 !: vertical eddy diffusivity for tracers (m2/s) 209 USE zdf_oce , ONLY : ln_zdfnpc => ln_zdfnpc !: convection: non-penetrative convection flag 210 # if defined key_zdfddm 211 USE zdfddm , ONLY : avs => avs !: salinity vertical diffusivity coeff. at w-point 212 # endif 213 214 !* mixing & mixed layer depth * 215 USE zdfmxl , ONLY : hmld => hmld !: mixing layer depth (turbocline) 216 USE zdfmxl , ONLY : hmlp => hmlp !: mixed layer depth (rho=rho0+zdcrit) (m) 217 USE zdfmxl , ONLY : hmlpt => hmlpt !: mixed layer depth at t-points (m) 218 219 !* direction of lateral diffusion * 220 USE ldfslp , ONLY : lk_ldfslp => lk_ldfslp !: slopes flag 221 # if defined key_ldfslp 222 USE ldfslp , ONLY : uslp => uslp !: i-direction slope at u-, w-points 223 USE ldfslp , ONLY : vslp => vslp !: j-direction slope at v-, w-points 224 USE ldfslp , ONLY : wslpi => wslpi !: i-direction slope at u-, w-points 225 USE ldfslp , ONLY : wslpj => wslpj !: j-direction slope at v-, w-points 226 # endif 227 228 #else 229 !!---------------------------------------------------------------------- 230 !! Empty module : No passive tracer 231 !!---------------------------------------------------------------------- 117 232 #endif 118 233 119 USE dom_oce , ONLY : & 120 ln_zps => ln_zps , & !: partial steps flag 121 ln_sco => ln_sco , & !: s-coordinate flag 122 ln_zco => ln_zco , & !: z-coordinate flag 123 lk_zco => lk_zco !: z-coordinate flag (1D or 3D arrays) 124 125 USE lib_mpp , ONLY : & 126 lk_mpp => lk_mpp !: Mpp flag 127 128 USE dynspg_oce , ONLY : & 129 lk_dynspg_rl => lk_dynspg_rl !: rigid lid flag 130 131 132 USE dom_oce , ONLY : & 133 hbatt => hbatt , & !: ocean depth at the vertical of t-point (m) 134 hbatu => hbatu , & !: ocean depth at the vertical of u-point (m) 135 hbatv => hbatv , & !: ocean depth at the vertical of w-point (m) 136 gsigt => gsigt , & !: model level depth coefficient at t-, & w-levelsvertical scale factors at u- 137 gsigw => gsigw , & !: model level depth coefficient at t-, & w-levelsvertical scale factors v- 138 gsi3w => gsi3w , & !: model level depth coef at w-levels (defined as the sum of e3w) 139 esigt => esigt , & !: vertical scale factor coef. at t-levels 140 esigw => esigw !: vertical scale factor coef. at w-levels 141 142 !! masks, bathymetry 143 USE dom_oce , ONLY : & 144 mbathy => mbathy, & !: number of ocean level (=0, & 1, ... , jpk-1) 145 tmask_i => tmask_i, & !: Interior mask at t-points 146 tmask => tmask , & !: land/ocean mask at t-points 147 umask => umask , & !: land/ocean mask at u-points 148 vmask => vmask , & !: land/ocean mask at v-points 149 fmask => fmask !: land/ocean mask at f-points 150 151 #if defined key_off_degrad 152 USE dom_oce , ONLY : & 153 facvol => facvol !: volume factor for degradation 154 #endif 155 156 USE dom_oce , ONLY : & 157 n_cla => n_cla !: flag (0/1) for cross land advection 158 159 !! time domain 160 USE dom_oce , ONLY : & 161 neuler => neuler, & !: restart euler forward option (0=Euler) 162 rdt => rdt , & !: time step for the dynamics 163 atfp => atfp , & !: asselin time filter parameter 164 atfp1 => atfp1 , & !: asselin time filter coeff. (atfp1= 1-2*atfp) 165 rdttra => rdttra !: vertical profile of tracer time step 166 167 USE daymod , ONLY : & 168 ndastp => ndastp, & !: time step date in year/month/day aammjj 169 nday_year => nday_year, & !: curent day counted from jan 1st of the current year 170 nyear => nyear, & !: Current year 171 nmonth => nmonth, & !: Current month 172 nday => nday !: Current day 173 174 !! physical constants 175 USE phycst , ONLY : & 176 ra => ra , & !: earth radius 177 rpi => rpi , & !: pi 178 rday => rday , & !: day 179 rauw => rauw , & !: density of pure water kg/m3 180 ro0cpr => ro0cpr, & !: = 1. / ( rau0 * rcp ) 181 rad => rad , & !: conversion coeff. from degre into radian 182 raass => raass , & !: number of seconds in one year 183 rmoss => rmoss , & !: number of seconds in one month 184 rjjss => rjjss !: number of seconds in one day 185 186 !! present fields (now) 187 USE oce , ONLY : & 188 ua => ua , & !: i-horizontal velocity (m s-1) 189 va => va , & !: j-horizontal velocity (m s-1) 190 un => un , & !: i-horizontal velocity (m s-1) 191 vn => vn , & !: j-horizontal velocity (m s-1) 192 wn => wn , & !: vertical velocity (m s-1) 193 tn => tn , & !: pot. temperature (celsius) 194 sn => sn , & !: salinity (psu) 195 rhop => rhop , & !: potential volumic mass (kg m-3) 196 rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 197 198 #if defined key_trc_diatrd 199 USE oce , ONLY : & 200 hdivn => hdivn !: horizontal divergence (1/s) 201 #endif 202 203 #if defined key_flx_bulk_monthly || defined key_flx_bulk_daily || defined key_flx_core 204 !! wind speed 205 USE blk_oce , ONLY : & 206 vatm => vatm !: wind speed at sea surface (m s-1) 207 #endif 208 209 !! wind speed 210 USE sbc_oce , ONLY : & 211 taux => utau , & !: i-surface stress component 212 tauy => vtau , & !: j-surface stress component 213 qsr => qsr , & !: penetrative solar radiation (w m-2) 214 emp => emp , & !: evaporation minus precipitation (kg m-2 s-2) 215 emps => emps !: evaporation minus precipitation (kg m-2 s-2) 216 217 218 #if defined key_trabbl_dif || defined key_trabbl_adv 219 USE trabbl , ONLY : & 220 atrbbl => atrbbl !: lateral coeff. for bottom boundary layer scheme (m2/s) 221 # if defined key_off_tra 222 USE trabbl, ONLY : & 223 bblx => bblx, & 224 bbly => bbly 225 # endif 226 #endif 227 228 !! lateral diffusivity (tracers) 229 USE ldftra_oce , ONLY : & 230 aht0 => aht0 , & !: horizontal eddy diffusivity for tracers (m2/s) 231 ahtb0 => ahtb0 , & !: background eddy diffusivity for isopycnal diff. (m2/s) 232 ahtu => ahtu , & !: lateral diffusivity coef. at u-points 233 ahtv => ahtv , & !: lateral diffusivity coef. at v-points 234 ahtw => ahtw , & !: lateral diffusivity coef. at w-points 235 ahtt => ahtt , & !: lateral diffusivity coef. at t-points 236 aeiv0 => aeiv0 , & !: eddy induced velocity coefficient (m2/s) 237 aeiu => aeiu , & !: eddy induced velocity coef. at u-points (m2/s) 238 aeiv => aeiv , & !: eddy induced velocity coef. at v-points (m2/s) 239 aeiw => aeiw !: eddy induced velocity coef. at w-points (m2/s) 240 241 !! vertical diffusion 242 USE zdf_oce , ONLY : & 243 avt => avt , & !: vert. diffusivity coef. at w-point for temp 244 avt0 => avt0 , & !: vertical eddy diffusivity for tracers (m2/s) 245 ln_zdfnpc => ln_zdfnpc !: convection: non-penetrative convection flag 246 247 248 #if defined key_zdfddm 249 USE zdfddm , ONLY : & 250 avs => avs !: salinity vertical diffusivity coeff. at w-point 251 #endif 252 253 !! penetrative solar radiation 254 USE traqsr , ONLY : & 255 xsi1 => xsi1 , & !: first depth of extinction 256 ln_qsr_sms => ln_qsr_sms !: flag to use or not the biological fluxes for light 257 258 !! freezing area 259 USE ocfzpt , ONLY : & 260 freeze => freeze, & !: ice mask (0 or 1) 261 fzptn => fzptn !: now freezing temperature at ocean surface 262 263 264 !! mixing layer depth (turbocline) 265 USE zdfmxl , ONLY : & 266 hmld => hmld , & !: mixing layer depth (turbocline) 267 hmlp => hmlp , & !: mixed layer depth (rho=rho0+zdcrit) (m) 268 hmlpt => hmlpt !: mixed layer depth at t-points (m) 269 270 USE ldfslp , ONLY : & 271 lk_ldfslp => lk_ldfslp !: slopes flag 272 #if defined key_ldfslp 273 !! direction of lateral diffusion (momentum tracers) 274 USE ldfslp , ONLY : & 275 uslp => uslp , & !: i-direction slope at u-, w-points 276 vslp => vslp , & !: j-direction slope at v-, w-points 277 wslpi => wslpi , & !: i-direction slope at u-, w-points 278 wslpj => wslpj !: j-direction slope at v-, w-points 279 #endif 280 281 !! ocean forcings runoff 282 USE sbcrnf , ONLY : & 283 upsrnfh => rnfmsk , & !: mixed adv scheme in runoffs vicinity (hori.) 284 upsrnfz => rnfmsk_z !: mixed adv scheme in runoffs vicinity (vert.) 285 234 !!====================================================================== 286 235 END MODULE oce_trc -
trunk/NEMO/TOP_SRC/par_trc.F90
r724 r945 2 2 !!====================================================================== 3 3 !! *** par_trc *** 4 !! passive tracers: set the passive tracers parameters4 !! TOP : set the passive tracers parameters 5 5 !!====================================================================== 6 !! History : 7 !! 8.2 ! 96-01 (M. Levy) Original code8 !! ! 99-07 (M. Levy) for LOBSTER1 or NPZD model9 !! ! 00-04 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD10 !! 9.0 ! 04-03 (C. Ethe) Free form and module6 !! History : - ! 1996-01 (M. Levy) original code 7 !! - ! 1999-07 (M. Levy) for LOBSTER1 or NPZD model 8 !! - ! 2000-04 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 9 !! 1.0 ! 2004-03 (C. Ethe) Free form and module 10 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 11 11 !!---------------------------------------------------------------------- 12 !! TOP 1.0, LOCEAN-IPSL (2005)13 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/par_trc.F90,v 1.6 2007/10/12 09:22:19 opalod Exp $14 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt12 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 13 !! $Id$ 14 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 15 15 !!---------------------------------------------------------------------- 16 !! * Modules used 17 #if defined key_passivetrc 18 19 USE par_trc_trp 16 USE par_kind ! kind parameters 17 ! 18 USE par_lobster ! LOBSTER model 19 USE par_pisces ! PISCES model 20 USE par_cfc ! CFC 11 and 12 tracers 21 USE par_my_trc ! user defined passive tracers 20 22 21 23 IMPLICIT NONE 22 24 PUBLIC 23 25 24 25 #if defined key_trc_diatrd 26 27 !! number of dynamical trends 28 # if defined key_trcldf_eiv 29 !! we keep 3 more trends for eddy induced flux (gent velocity) 30 # if defined key_trcdmp 31 INTEGER , PARAMETER :: jpdiatrc = 11 32 # else 33 INTEGER , PARAMETER :: jpdiatrc = 10 34 # endif 35 # else 36 # if defined key_trcdmp 37 INTEGER , PARAMETER :: jpdiatrc = 8 38 # else 39 INTEGER , PARAMETER :: jpdiatrc = 7 40 # endif 41 # endif 26 ! Passive tracers : Total size 27 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 28 INTEGER, PUBLIC, PARAMETER :: jptra = jp_lobster + jp_pisces + jp_cfc + jp_my_trc 29 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_lobster_2d + jp_pisces_2d + jp_cfc_2d + jp_my_trc_2d 30 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_lobster_3d + jp_pisces_3d + jp_cfc_3d + jp_my_trc_3d 31 ! ! total number of sms diagnostic arrays 32 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_my_trc_trd 33 34 ! 1D configuration ("key_c1d") 35 ! ----------------- 36 # if defined key_c1d 37 LOGICAL, PUBLIC, PARAMETER :: lk_trc_c1d = .TRUE. !: 1D pass. tracer configuration flag 38 # else 39 LOGICAL, PUBLIC, PARAMETER :: lk_trc_c1d = .FALSE. !: 1D pass. tracer configuration flag 42 40 # endif 43 41 42 ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 43 #if defined key_trcldf_eiv 44 # if defined key_trcdmp 45 INTEGER, PARAMETER :: jpdiatrc = 11 !: trends: 3*(advection + diffusion + eiv ) + damping + sms 46 # else 47 INTEGER, PARAMETER :: jpdiatrc = 10 !: trends: 3*(advection + diffusion + eiv ) + sms 48 # endif 44 49 #else 45 !!====================================================================== 46 !! Empty module : No passive tracer 47 !!====================================================================== 50 # if defined key_trcdmp 51 INTEGER, PARAMETER :: jpdiatrc = 8 !: trends: 3*(advection + diffusion ) + damping + sms 52 # else 53 INTEGER, PARAMETER :: jpdiatrc = 7 !: trends: 3*(advection + diffusion ) + damping + sms 54 # endif 48 55 #endif 49 56 57 !!====================================================================== 50 58 END MODULE par_trc -
trunk/NEMO/TOP_SRC/prtctl_trc.F90
r719 r945 1 1 MODULE prtctl_trc 2 !!============================================================================== 3 !! *** MODULE prtctl *** 4 !! Ocean system : print all SUM trends for each processor domain 5 !!============================================================================== 6 #if defined key_passivetrc 7 8 USE par_trc_trp 2 !!====================================================================== 3 !! *** MODULE prtctl_trc *** 4 !! TOP : print all SUM trends for each processor domain 5 !!====================================================================== 6 !! History : - ! 2005-07 (C. Talandier) original code for OPA 7 !! 1.0 ! 2005-10 (C. Ethe ) adapted to passive tracer 8 !!---------------------------------------------------------------------- 9 #if defined key_top 10 !!---------------------------------------------------------------------- 11 !! 'key_top' TOP models 12 !!---------------------------------------------------------------------- 13 !! prt_ctl_trc : control print in mpp for passive tracers 14 !! prt_ctl_trc_info : ??? 15 !! prt_ctl_trc_init : ??? 16 !!---------------------------------------------------------------------- 17 USE par_trc ! TOP parameters 9 18 USE oce_trc ! ocean space and time domain variables 10 19 USE in_out_manager ! I/O manager … … 14 23 PRIVATE 15 24 16 !! * Module declaration 17 INTEGER, DIMENSION(:), ALLOCATABLE :: numid_trc ! logical unit 18 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: & !: 19 nlditl , nldjtl , & !: first, last indoor index for each i-domain 20 nleitl , nlejtl , & !: first, last indoor index for each j-domain 21 nimpptl, njmpptl, & !: i-, j-indexes for each processor 22 nlcitl , nlcjtl , & !: dimensions of every subdomain 23 ibonitl, ibonjtl 24 25 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & !: 26 tra_ctl !: previous trend values 27 28 !! * Routine accessibility 25 INTEGER , DIMENSION(:), ALLOCATABLE :: numid_trc !: logical unit 26 INTEGER , DIMENSION(:), ALLOCATABLE :: nlditl , nldjtl !: first, last indoor index for each i-domain 27 INTEGER , DIMENSION(:), ALLOCATABLE :: nleitl , nlejtl !: first, last indoor index for each j-domain 28 INTEGER , DIMENSION(:), ALLOCATABLE :: nimpptl, njmpptl !: i-, j-indexes for each processor 29 INTEGER , DIMENSION(:), ALLOCATABLE :: nlcitl , nlcjtl !: dimensions of every subdomain 30 INTEGER , DIMENSION(:), ALLOCATABLE :: ibonitl, ibonjtl 31 32 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tra_ctl !: previous trend values 33 29 34 PUBLIC prt_ctl_trc ! called by all subroutines 30 35 PUBLIC prt_ctl_trc_info ! 31 36 PUBLIC prt_ctl_trc_init ! called by opa.F90 32 !!---------------------------------------------------------------------- 33 !! OPA 9.0 , LOCEAN-IPSL (2005)34 !! $Header$35 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt36 !! ----------------------------------------------------------------------37 37 38 !!---------------------------------------------------------------------- 39 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 40 !! $Header:$ 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 38 43 39 44 CONTAINS 40 45 41 SUBROUTINE prt_ctl_trc (tab4d, mask, clinfo, ovlap, kdim, clinfo2)46 SUBROUTINE prt_ctl_trc( tab4d, mask, clinfo, ovlap, kdim, clinfo2 ) 42 47 !!---------------------------------------------------------------------- 43 48 !! *** ROUTINE prt_ctl *** … … 61 66 !! name must be explicitly typed if used. For instance if the mask 62 67 !! array tmask(:,:,:) must be passed through the prt_ctl subroutine, 63 !! it must looks like: CALL prt_ctl(mask=tmask). 64 !! 65 !! tab4d : 4D array 66 !! mask : mask (3D) to apply to the tab4d array 67 !! clinfo : information about the tab3d array 68 !! ovlap : overlap value 69 !! kdim : k- direction for 4D arrays 70 !! 71 !! History : 72 !! 9.0 ! 05-07 (C. Talandier) original code 73 !! ! 05-10 (C. Ethe ) adapted to passive tracer 74 !!---------------------------------------------------------------------- 75 !! * Arguments 76 REAL(wp), DIMENSION(:,:,:,:), INTENT(in), OPTIONAL :: tab4d 77 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: mask 78 CHARACTER (len=*), DIMENSION(:), INTENT(in), OPTIONAL :: clinfo 79 CHARACTER (len=*), INTENT(in), OPTIONAL :: clinfo2 80 INTEGER, INTENT(in), OPTIONAL :: ovlap 81 INTEGER, INTENT(in), OPTIONAL :: kdim 82 83 !! * Local declarations 84 INTEGER :: overlap, jn, js, sind, eind, kdir, j_id 85 REAL(wp) :: zsum, zvctl 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, ztab3d 87 CHARACTER (len=20), DIMENSION(jptra) :: cl 88 CHARACTER (len=10) :: cl2 89 !!---------------------------------------------------------------------- 90 91 ! Arrays, scalars initialization 68 !! it must looks like: CALL prt_ctl( mask=tmask ). 69 !!---------------------------------------------------------------------- 70 REAL(wp) , DIMENSION(:,:,:,:), INTENT(in), OPTIONAL :: tab4d ! 4D array 71 REAL(wp) , DIMENSION(:,:,:) , INTENT(in), OPTIONAL :: mask ! 3D mask to apply to the tab4d array 72 CHARACTER (len=*), DIMENSION(:) , INTENT(in), OPTIONAL :: clinfo ! information about the tab3d array 73 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo2 ! ??? 74 INTEGER , INTENT(in), OPTIONAL :: ovlap ! overlap value 75 INTEGER , INTENT(in), OPTIONAL :: kdim ! k- direction for 4D arrays 76 !! 77 INTEGER :: overlap, jn, js, sind, eind, kdir, j_id 78 REAL(wp) :: zsum, zvctl 79 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask, ztab3d 80 CHARACTER (len=20), DIMENSION(jptra) :: cl 81 CHARACTER (len=10) :: cl2 82 !!---------------------------------------------------------------------- 83 84 ! ! Arrays, scalars initialization 92 85 overlap = 0 93 86 kdir = jpkm1 … … 99 92 zmask (:,:,:) = 1.e0 100 93 101 ! Control of optional arguments 102 103 IF( PRESENT(ovlap) ) overlap = ovlap 104 IF( PRESENT(kdim) ) kdir = kdim 105 IF( PRESENT(clinfo ) ) cl(:) = clinfo(:) 106 IF( PRESENT(clinfo2) ) cl2 = clinfo2 107 IF( PRESENT(mask) ) zmask (:,:,:) = mask(:,:,:) 108 109 IF( lk_mpp ) THEN 110 ! processor number 94 ! ! Control of optional arguments 95 IF( PRESENT(ovlap) ) overlap = ovlap 96 IF( PRESENT(kdim) ) kdir = kdim 97 IF( PRESENT(clinfo ) ) cl(:) = clinfo(:) 98 IF( PRESENT(clinfo2) ) cl2 = clinfo2 99 IF( PRESENT(mask) ) zmask (:,:,:) = mask(:,:,:) 100 101 IF( lk_mpp ) THEN ! processor number 111 102 sind = narea 112 103 eind = narea 113 ELSE 114 ! processors total number 104 ELSE ! processors total number 115 105 sind = 1 116 106 eind = ijsplt … … 119 109 ! Loop over each sub-domain, i.e. the total number of processors ijsplt 120 110 DO js = sind, eind 121 111 ! 122 112 ! Set logical unit 123 j_id = numid_trc( js - narea + 1)113 j_id = numid_trc( js - narea + 1 ) 124 114 ! Set indices for the SUM control 125 115 IF( .NOT. lsp_area ) THEN … … 130 120 njctle = nlejtl(js) + overlap * MIN( 1, nlcjtl(js) - nlejtl(js)) 131 121 ! Do not take into account the bound of the domain 132 IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 ) nictls = MAX(2, nictls)133 IF( ibonitl(js) == 1 .OR. ibonitl(js) == 2 ) nictle = MIN(nictle, nleitl(js) - 1)134 IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 ) njctls = MAX(2, njctls)135 IF( ibonjtl(js) == 1 .OR. ibonjtl(js) == 2 ) njctle = MIN(njctle, nlejtl(js) - 1)122 IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 ) nictls = MAX( 2, nictls ) 123 IF( ibonitl(js) == 1 .OR. ibonitl(js) == 2 ) nictle = MIN( nictle, nleitl(js) - 1 ) 124 IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 ) njctls = MAX( 2, njctls ) 125 IF( ibonjtl(js) == 1 .OR. ibonjtl(js) == 2 ) njctle = MIN( njctle, nlejtl(js) - 1 ) 136 126 ELSE 137 127 nictls = MAX( 1, nimpptl(js) + nlditl(js) - 1 - overlap ) … … 140 130 njctle = njmpptl(js) + nlejtl(js) - 1 + overlap * MIN( 1, nlcjtl(js) - nlejtl(js) ) 141 131 ! Do not take into account the bound of the domain 142 IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 ) nictls = MAX(2, nictls)143 IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 ) njctls = MAX(2, njctls)144 IF( ibonitl(js) == 1 .OR. ibonitl(js) == 2 ) nictle = MIN(nictle, nimpptl(js) + nleitl(js) - 2)145 IF( ibonjtl(js) == 1 .OR. ibonjtl(js) == 2 ) njctle = MIN(njctle, njmpptl(js) + nlejtl(js) - 2)132 IF( ibonitl(js) == -1 .OR. ibonitl(js) == 2 ) nictls = MAX( 2, nictls ) 133 IF( ibonjtl(js) == -1 .OR. ibonjtl(js) == 2 ) njctls = MAX( 2, njctls ) 134 IF( ibonitl(js) == 1 .OR. ibonitl(js) == 2 ) nictle = MIN( nictle, nimpptl(js) + nleitl(js) - 2 ) 135 IF( ibonjtl(js) == 1 .OR. ibonjtl(js) == 2 ) njctle = MIN( njctle, njmpptl(js) + nlejtl(js) - 2 ) 146 136 ENDIF 147 137 ENDIF 148 138 ! 149 139 IF( PRESENT(clinfo2) ) THEN 150 140 DO jn = 1, jptra 151 141 zvctl = tra_ctl(jn,js) 152 142 ztab3d(:,:,:) = tab4d(:,:,:,jn) 153 zsum = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir) &154 & *zmask(nictls:nictle,njctls:njctle,1:kdir) )143 zsum = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir) & 144 & * zmask(nictls:nictle,njctls:njctle,1:kdir) ) 155 145 WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum-zvctl 156 146 tra_ctl(jn,js) = zsum 157 END DO147 END DO 158 148 ELSE 159 149 DO jn = 1, jptra 160 150 ztab3d(:,:,:) = tab4d(:,:,:,jn) 161 zsum = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir) &162 & * zmask(nictls:nictle,njctls:njctle,1:kdir) )151 zsum = SUM( ztab3d(nictls:nictle,njctls:njctle,1:kdir) & 152 & * zmask(nictls:nictle,njctls:njctle,1:kdir) ) 163 153 WRITE(j_id,FMT="(3x,a,' : ',D23.16)") cl(jn), zsum 164 154 END DO 165 155 ENDIF 166 167 168 ENDDO 169 156 ! 157 END DO 158 ! 170 159 END SUBROUTINE prt_ctl_trc 171 160 172 SUBROUTINE prt_ctl_trc_info (clinfo) 161 162 SUBROUTINE prt_ctl_trc_info( clinfo ) 173 163 !!---------------------------------------------------------------------- 174 164 !! *** ROUTINE prt_ctl_trc_info *** 175 165 !! 176 166 !! ** Purpose : - print information without any computation 177 !! 178 !! ** Action : - input arguments 179 !! clinfo : information to print 180 !! 181 !! History : 182 !! 9.0 ! 05-07 (C. Talandier) original code 183 !!---------------------------------------------------------------------- 184 !! * Arguments 185 CHARACTER (len=*), INTENT(in) :: clinfo 186 187 !! * Local declarations 188 INTEGER :: js, sind, eind, j_id 189 !!---------------------------------------------------------------------- 190 191 IF( lk_mpp ) THEN 192 ! processor number 167 !!---------------------------------------------------------------------- 168 CHARACTER (len=*), INTENT(in) :: clinfo ! information to print 169 !! 170 INTEGER :: js, sind, eind, j_id 171 !!---------------------------------------------------------------------- 172 173 IF( lk_mpp ) THEN ! processor number 193 174 sind = narea 194 175 eind = narea 195 ELSE 196 ! total number of processors 176 ELSE ! total number of processors 197 177 sind = 1 198 178 eind = ijsplt … … 202 182 DO js = sind, eind 203 183 j_id = numid_trc(js - narea + 1) 204 WRITE(j_id,*)clinfo 205 ENDDO 206 207 184 WRITE(j_id,*) clinfo 185 END DO 186 ! 208 187 END SUBROUTINE prt_ctl_trc_info 209 188 189 210 190 SUBROUTINE prt_ctl_trc_init 211 191 !!---------------------------------------------------------------------- … … 213 193 !! 214 194 !! ** Purpose : open ASCII files & compute indices 215 !! 216 !! History : 217 !! 9.0 ! 05-07 (C. Talandier) original code 218 !! ! 05-10 (C. Ethe ) adapted to passive tracer 219 !!---------------------------------------------------------------------- 220 !! * Local declarations 221 INTEGER :: js, sind, eind, j_id 195 !!---------------------------------------------------------------------- 196 INTEGER :: js, sind, eind, j_id 222 197 CHARACTER (len=31) :: clfile_out 223 198 CHARACTER (len=27) :: clb_name … … 225 200 !!---------------------------------------------------------------------- 226 201 227 ! Allocate arrays 228 ALLOCATE(nlditl (ijsplt)) 229 ALLOCATE(nldjtl (ijsplt)) 230 ALLOCATE(nleitl (ijsplt)) 231 ALLOCATE(nlejtl (ijsplt)) 232 ALLOCATE(nimpptl(ijsplt)) 233 ALLOCATE(njmpptl(ijsplt)) 234 ALLOCATE(nlcitl (ijsplt)) 235 ALLOCATE(nlcjtl (ijsplt)) 236 ALLOCATE(tra_ctl(jptra,ijsplt)) 237 ALLOCATE(ibonitl(ijsplt)) 238 ALLOCATE(ibonjtl(ijsplt)) 239 240 ! Initialization 241 tra_ctl (:,:)=0.e0 202 ! ! Allocate arrays 203 ALLOCATE( nlditl (ijsplt) ) 204 ALLOCATE( nldjtl (ijsplt) ) 205 ALLOCATE( nleitl (ijsplt) ) 206 ALLOCATE( nlejtl (ijsplt) ) 207 ALLOCATE( nimpptl(ijsplt) ) 208 ALLOCATE( njmpptl(ijsplt) ) 209 ALLOCATE( nlcitl (ijsplt) ) 210 ALLOCATE( nlcjtl (ijsplt) ) 211 ALLOCATE( tra_ctl(jptra,ijsplt) ) 212 ALLOCATE( ibonitl(ijsplt) ) 213 ALLOCATE( ibonjtl(ijsplt) ) 214 215 tra_ctl(:,:) = 0.e0 ! Initialization to zero 242 216 243 217 IF( lk_mpp ) THEN … … 264 238 eind = ijsplt 265 239 clb_name = "('mono.top.output_',I3.3)" 266 cl_run = 'MONO processor run '240 cl_run = 'MONO processor run ' 267 241 ! compute indices for each area as done in mpp_init subroutine 268 242 CALL sub_dom 269 243 ENDIF 270 244 271 ALLOCATE( numid_trc(eind-sind+1))245 ALLOCATE( numid_trc(eind-sind+1) ) 272 246 273 247 DO js = sind, eind … … 278 252 WRITE(j_id,*) 279 253 WRITE(j_id,*) ' L O D Y C - I P S L' 280 WRITE(j_id,*) ' O P A model'254 WRITE(j_id,*) ' N E M 0 ' 281 255 WRITE(j_id,*) ' Ocean General Circulation Model' 282 WRITE(j_id,*) ' version OPA 9.0 (2005) '256 WRITE(j_id,*) ' version TOP 1.0 (2005) ' 283 257 WRITE(j_id,*) 284 258 WRITE(j_id,*) ' PROC number: ', js 285 259 WRITE(j_id,*) 286 WRITE(j_id,FMT="(19x,a20)") cl_run260 WRITE(j_id,FMT="(19x,a20)") cl_run 287 261 288 262 ! Print the SUM control indices … … 324 298 9003 FORMAT(a20,i4.4,a17,i4.4) 325 299 9004 FORMAT(a11,i4.4,a26,i4.4,a14) 326 END DO327 300 END DO 301 ! 328 302 END SUBROUTINE prt_ctl_trc_init 329 303 … … 358 332 !! nbondil : mark for "east-west local boundary" 359 333 !! nbondjl : mark for "north-south local boundary" 360 !! 361 !! History : 362 !! ! 94-11 (M. Guyon) Original code 363 !! ! 95-04 (J. Escobar, M. Imbard) 364 !! ! 98-02 (M. Guyon) FETI method 365 !! ! 98-05 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI versions 366 !! 8.5 ! 02-08 (G. Madec) F90 : free form 367 !!---------------------------------------------------------------------- 368 !! * Local variables 334 !!---------------------------------------------------------------------- 369 335 INTEGER :: ji, jj, js ! dummy loop indices 370 INTEGER :: & 371 ii, ij, & ! temporary integers 372 irestil, irestjl, & ! " " 373 ijpi , ijpj, nlcil, & ! temporary logical unit 374 nlcjl , nbondil, nbondjl, & 375 nrecil, nrecjl, nldil, nleil, nldjl, nlejl 376 377 INTEGER, DIMENSION(:,:), ALLOCATABLE :: & 378 iimpptl, ijmpptl, ilcitl, ilcjtl ! temporary workspace 336 INTEGER :: ii, ij ! temporary integers 337 INTEGER :: irestil, irestjl ! " " 338 INTEGER :: ijpi , ijpj, nlcil ! temporary logical unit 339 INTEGER :: nlcjl , nbondil, nbondjl 340 INTEGER :: nrecil, nrecjl, nldil, nleil, nldjl, nlejl 379 341 REAL(wp) :: zidom, zjdom ! temporary scalars 380 !!---------------------------------------------------------------------- 381 382 ! 1. Dimension arrays for subdomains 383 ! ----------------------------------- 342 INTEGER, DIMENSION(:,:), ALLOCATABLE :: iimpptl, ijmpptl, ilcitl, ilcjtl ! temporary workspace 343 !!---------------------------------------------------------------------- 344 345 ! Dimension arrays for subdomains 346 ! ------------------------------- 384 347 ! Computation of local domain sizes ilcitl() ilcjtl() 385 348 ! These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo … … 391 354 ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 392 355 393 ALLOCATE( ilcitl (isplt,jsplt))394 ALLOCATE( ilcjtl (isplt,jsplt))356 ALLOCATE( ilcitl (isplt,jsplt) ) 357 ALLOCATE( ilcjtl (isplt,jsplt) ) 395 358 396 359 nrecil = 2 * jpreci … … 429 392 END DO 430 393 431 ! 2.Index arrays for subdomains432 ! --------------------------- ----433 434 ALLOCATE( iimpptl(isplt,jsplt))435 ALLOCATE( ijmpptl(isplt,jsplt))394 ! Index arrays for subdomains 395 ! --------------------------- 396 397 ALLOCATE( iimpptl(isplt,jsplt) ) 398 ALLOCATE( ijmpptl(isplt,jsplt) ) 436 399 437 400 iimpptl(:,:) = 1 … … 454 417 ENDIF 455 418 456 ! 3.Subdomain description457 ! --------------------- ---419 ! Subdomain description 420 ! --------------------- 458 421 459 422 DO js = 1, ijsplt … … 492 455 END DO 493 456 494 DEALLOCATE( iimpptl)495 DEALLOCATE( ijmpptl)496 DEALLOCATE( ilcitl)497 DEALLOCATE( ilcjtl)498 457 DEALLOCATE( iimpptl ) 458 DEALLOCATE( ijmpptl ) 459 DEALLOCATE( ilcitl ) 460 DEALLOCATE( ilcjtl ) 461 ! 499 462 END SUBROUTINE sub_dom 500 463 501 464 #else 502 465 !!---------------------------------------------------------------------- 503 !! Dummy module : NO passive tracer466 !! Dummy module : NO passive tracer 504 467 !!---------------------------------------------------------------------- 505 468 #endif 506 469 507 470 !!====================================================================== 508 509 471 END MODULE prtctl_trc -
trunk/NEMO/TOP_SRC/trc.F90
r899 r945 4 4 !! Passive tracers : module for tracers defined 5 5 !!====================================================================== 6 !! History : 7 !! 8.2 ! 96-01 (M. Levy) Original code 8 !! ! 99-07 (M. Levy) for LOBSTER1 or NPZD model 9 !! ! 00-04 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 10 !! 9.0 ! 04-03 (C. Ethe) Free form and module 6 !! History : - ! 1996-01 (M. Levy) Original code 7 !! - ! 1999-07 (M. Levy) for LOBSTER1 or NPZD model 8 !! - ! 2000-04 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 9 !! 1.0 ! 2004-03 (C. Ethe) Free form and module 11 10 !!---------------------------------------------------------------------- 12 !! TOP 1.0,LOCEAN-IPSL (2005)13 !! $ Header$14 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt11 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 12 !! $Id$ 13 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 15 14 !!---------------------------------------------------------------------- 16 #if defined key_ passivetrc15 #if defined key_top 17 16 !!---------------------------------------------------------------------- 18 !! 'key_passivetrc' : Passive tracer 19 !!--------------------------------------------------------------------- 20 !! * Modules used 17 !! 'key_top' TOP models 18 !!---------------------------------------------------------------------- 21 19 USE par_oce 22 20 USE par_trc 21 23 22 IMPLICIT NONE 24 25 23 PUBLIC 26 27 24 28 25 !! passive tracers names and units (read in namelist) 29 26 !! -------------------------------------------------- 30 CHARACTER(len=12), PUBLIC, DIMENSION(jptra) :: & 31 ctrcnm , & !!: tracer name 32 ctrcun !!: tracer unit 33 34 CHARACTER(len=80), PUBLIC, DIMENSION(jptra) :: & 35 ctrcnl !!: tracer long name 27 CHARACTER(len=12), PUBLIC, DIMENSION(jptra) :: ctrcnm !: tracer name 28 CHARACTER(len=12), PUBLIC, DIMENSION(jptra) :: ctrcun !: tracer unit 29 CHARACTER(len=80), PUBLIC, DIMENSION(jptra) :: ctrcnl !: tracer long name 36 30 37 31 38 32 !! parameters for the control of passive tracers 39 33 !! -------------------------------------------------- 40 INTEGER, PUBLIC :: & 41 numnat !!: the number of the passive tracer NAMELIST 42 43 LOGICAL, PUBLIC, DIMENSION(jptra) :: & 44 lutini !!: initialisation from FILE or not (NAMELIST) 45 46 INTEGER , PUBLIC, DIMENSION(jptra) :: & 47 nutini !!: FORTRAN LOGICAL UNIT for initialisation file 34 INTEGER, PUBLIC :: numnat !: the number of the passive tracer NAMELIST 35 LOGICAL, PUBLIC, DIMENSION(jptra) :: lutini !: initialisation from FILE or not (NAMELIST) 36 LOGICAL, PUBLIC, DIMENSION(jptra) :: lutsav !: logical for saving tracer or not 37 INTEGER, PUBLIC, DIMENSION(jptra) :: nutini !: FORTRAN LOGICAL UNIT for initialisation file 48 38 49 39 !! passive tracers fields (before,now,after) 50 40 !! -------------------------------------------------- 51 REAL(wp), PUBLIC, SAVE :: & 52 trai , & !!: initial total tracer 53 areatot !!: total volume 41 REAL(wp), PUBLIC :: trai !: initial total tracer 42 REAL(wp), PUBLIC :: areatot !: total volume 54 43 55 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: & 56 trn , & !!: traceur concentration for actual time step 57 tra , & !!: traceur concentration for next time step 58 trb !!: traceur concentration for before time step 44 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: trn !: traceur concentration for actual time step 45 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: tra !: traceur concentration for next time step 46 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jptra) :: trb !: traceur concentration for before time step 59 47 60 48 61 49 !! numerical parameter (NAMELIST) 62 50 !! -------------------------------------------------- 63 REAL(wp), PUBLIC :: & 64 rsc , & !!: tuning coefficient for anti-diffusion 65 rtrn !!: value for truncation 51 REAL(wp), PUBLIC :: rsc !: tuning coefficient for anti-diffusion 52 REAL(wp), PUBLIC :: rtrn !: value for truncation 66 53 67 54 !! namelist parameters 68 55 !! -------------------------------------------------- 69 INTEGER , PUBLIC :: & 70 ncortrc , & !!: number of corrective phases 71 ndttrc , & !!: frequency of step on passive tracers 72 nittrc000 !!: first time step of passive tracers model 73 74 LOGICAL, PUBLIC :: & 75 crosster !!: logical if true computes crossterms 56 INTEGER , PUBLIC :: ncortrc !: number of corrective phases 57 INTEGER , PUBLIC :: ndttrc !: frequency of step on passive tracers 58 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 59 LOGICAL , PUBLIC :: crosster !: logical if true computes crossterms 76 60 77 61 78 62 !! isopycnal scheme for passive tracers 79 !! -------------------------------------------------- 80 REAL(wp), PUBLIC :: & 81 ahtrb0 , & !!: background diffusivity coefficient for passive tracer (m2/s) 82 trcrat , & !!: ratio between passive and active tracer coeff for diffusion 83 ahtrc0 , & !!: horizontal eddy diffusivity for passive tracers (m2/s) 84 aeivtr0 !!: eddy induced velocity coefficient (m2/s) 63 !! ------------------------------------ 64 REAL(wp), PUBLIC :: ahtrb0 !: background diffusivity coefficient for passive tracer (m2/s) 65 REAL(wp), PUBLIC :: trcrat !: ratio between passive and active tracer coeff for diffusion 66 REAL(wp), PUBLIC :: ahtrc0 !: horizontal eddy diffusivity for passive tracers (m2/s) 67 REAL(wp), PUBLIC :: aeivtr0 !: eddy induced velocity coefficient (m2/s) 85 68 86 69 87 70 !! passive tracers restart (input and output) 88 !! -------------------------------------------------- 89 LOGICAL, PUBLIC :: & 90 lrsttr !!: boolean term for restart i/o for passive tracers (namelist) 91 92 INTEGER , PUBLIC :: & 93 nutwrs , & !!: output FILE for passive tracers restart 94 nutrst , & !!: logical unit for restart FILE for passive tracers 95 nrsttr !!: control of the time step ( 0 or 1 ) for pass. tr. 71 !! ------------------------------------------ 72 LOGICAL , PUBLIC :: lrsttr !: boolean term for restart i/o for passive tracers (namelist) 73 INTEGER , PUBLIC :: nutwrs !: output FILE for passive tracers restart 74 INTEGER , PUBLIC :: nutrst !: logical unit for restart FILE for passive tracers 75 INTEGER , PUBLIC :: nrsttr !: control of the time step ( 0 or 1 ) for pass. tr. 96 76 97 77 98 78 !! interpolated gradient 99 79 !!-------------------------------------------------- 100 REAL (wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: & 101 gtru , & !!: horizontal gradient at u-points at bottom ocean level 102 gtrv !!: horizontal gradient at v-points at bottom ocean level 80 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtru !: horizontal gradient at u-points at bottom ocean level 81 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jptra) :: gtrv !: horizontal gradient at v-points at bottom ocean level 103 82 104 83 105 # if defined key_trcldf_eiv && defined key_diaeiv84 # if defined key_trcldf_eiv && defined key_diaeiv 106 85 !! The three component of the eddy induced velocity 107 86 !! -------------------------------------------------- 108 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: & 109 u_trc_eiv, & !!: u-eiv (m/s) 110 v_trc_eiv, & !!: v-eiv (m/s) 111 w_trc_eiv !!: w-eiv (m/s) 112 #endif 87 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: u_trc_eiv !: u-eiv (m/s) 88 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: v_trc_eiv !: v-eiv (m/s) 89 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk) :: w_trc_eiv !: w-eiv (m/s) 90 # endif 113 91 114 92 115 93 !! information for outputs 116 94 !! -------------------------------------------------- 117 INTEGER , PUBLIC :: & 118 nwritetrc !!: time step frequency for concentration outputs (namelist) 95 INTEGER , PUBLIC :: nwritetrc !: time step frequency for concentration outputs (namelist) 119 96 120 # if defined key_trc_diaadd97 # if defined key_trc_diaadd 121 98 !! additional 2D/3D outputs namelist 122 99 !! -------------------------------------------------- 123 CHARACTER(len=8), PUBLIC, DIMENSION (jpdia2d) :: & 124 ctrc2d , & !!: 2d output field name 125 ctrc2u !!: 2d output field unit 100 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) :: ctrc2d !: 2d output field name 101 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia2d) :: ctrc2u !: 2d output field unit 102 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) :: ctrc3d !: 3d output field name 103 CHARACTER(len= 8), PUBLIC, DIMENSION (jpdia3d) :: ctrc3u !: 3d output field unit 104 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) :: ctrc2l !: 2d output field long name 105 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) :: ctrc3l !: 3d output field long name 106 126 107 127 CHARACTER(len=8), PUBLIC, DIMENSION (jpdia3d) :: & 128 ctrc3d , & !!: 3d output field name 129 ctrc3u !!: 3d output field unit 130 131 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia2d) :: & 132 ctrc2l !!: 2d output field long name 133 134 CHARACTER(len=80), PUBLIC, DIMENSION (jpdia3d) :: & 135 ctrc3l !!: 3d output field long name 136 137 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpdia2d) :: & 138 trc2d !!: additional 2d outputs 139 140 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) :: & 141 trc3d !!: additional 3d outputs 108 REAL(wp), PUBLIC, DIMENSION (jpi,jpj, jpdia2d) :: trc2d !: additional 2d outputs 109 REAL(wp), PUBLIC, DIMENSION (jpi,jpj,jpk,jpdia3d) :: trc3d !: additional 3d outputs 142 110 143 111 144 112 !! netcdf files and index common 145 113 !! -------------------------------------------------- 146 INTEGER , PUBLIC :: & 147 nwriteadd !!: frequency of additional arrays outputs(namelist) 148 #endif 114 INTEGER , PUBLIC :: nwritedia !: frequency of additional arrays outputs(namelist) 115 # endif 149 116 150 # if defined key_trc_diatrd117 # if defined key_trc_diatrd 151 118 152 119 !! non conservative trends (biological, ...) 153 120 !! -------------------------------------------------- 154 LOGICAL, PUBLIC, DIMENSION (jptra) :: & 155 luttrd !!: large trends diagnostic to write or not (namelist) 121 LOGICAL, PUBLIC, DIMENSION (jptra) :: luttrd !: large trends diagnostic to write or not (namelist) 156 122 157 !! dynamical trends 158 !! trtrd() : trends of the tracer equations 159 !! 1 : X advection 160 !! 2 : Y advection 161 !! 3 : Z advection 162 !! 4 : X diffusion 163 !! 5 : Y diffusion 164 !! 6 : Z diffusion 165 !! 7 : X gent velocity 166 !! 8 : Y gent velocity 167 !! 9 : Z gent velocity 123 !! Advection-diffusion trends 168 124 !! -------------------------------------------------- 125 REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: trtrd !: trends of the tracer equations 169 126 170 171 REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE, SAVE :: & 172 trtrd !!: trends of the tracer equations 173 174 INTEGER, PUBLIC, DIMENSION(jptra), SAVE :: ikeep ! indice of tracer for which dyn trends are stored 175 INTEGER, PUBLIC, SAVE :: nkeep ! number of tracers for which dyn trends are stored 176 ! (used to allocate trtrd buffer) 127 INTEGER, PUBLIC, DIMENSION(jptra) :: ikeep ! indice of tracer for which dyn trends are stored 128 INTEGER, PUBLIC :: nkeep ! number of tracers for which dyn trends are stored 129 ! ! (used to allocate trtrd buffer) 177 130 178 131 !! netcdf files and index common 179 132 !! -------------------------------------------------- 180 INTEGER , PUBLIC :: & 181 nwritetrd !!: frequency of additional arrays outputs(namelist) 133 INTEGER , PUBLIC :: nwritetrd !: frequency of additional arrays outputs(namelist) 182 134 183 # endif135 # endif 184 136 185 137 !! passive tracers data read and at given time_step 186 138 !! -------------------------------------------------- 187 #if defined key_dtatrc 188 189 INTEGER , PUBLIC, DIMENSION(jptra) :: & 190 numtr !!: logical unit for passive tracers data 191 139 # if defined key_dtatrc 140 INTEGER , PUBLIC, DIMENSION(jptra) :: numtr !: logical unit for passive tracers data 141 # endif 142 143 #else 144 !!---------------------------------------------------------------------- 145 !! Empty module : No passive tracer 146 !!---------------------------------------------------------------------- 192 147 #endif 193 148 194 !! 1D configuration195 !! --------------------------------------------------196 #if defined key_cf1d197 LOGICAL, PARAMETER :: lk_trccfg_1d = .TRUE. !: 1D pass. tracer configuration flag198 #else199 LOGICAL, PARAMETER :: lk_trccfg_1d = .FALSE. !: 1D pass. tracer configuration flag200 #endif201 202 203 #else204 149 !!====================================================================== 205 !! Empty module : No passive tracer206 !!======================================================================207 #endif208 209 150 END MODULE trc -
trunk/NEMO/TOP_SRC/trcctl.F90
r719 r945 1 1 MODULE trcctl 2 !!========================================================================== 3 !! 4 !! *** MODULE trcctl *** 5 !! 6 !! Only for passive tracer 7 !! control the cpp options for the run and IF files are availables 8 !! control also consistancy between options and namelist values 9 !! O.Aumont and A.El Moussaoui 03/05 F90 10 !!========================================================================= 11 !! TOP 1.0, LOCEAN-IPSL (2005) 12 !! $Header$ 13 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 2 !!====================================================================== 3 !! *** MODULE trcctl *** 4 !! TOP : control the cpp options, files and namelist values of a run 5 !!====================================================================== 6 !! History : 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) original code 14 7 !!---------------------------------------------------------------------- 15 #if defined key_ passivetrc8 #if defined key_top 16 9 !!---------------------------------------------------------------------- 17 !! * Modules used 18 !! ============== 10 !! 'key_top' TOP models 11 !!---------------------------------------------------------------------- 12 !! trc_ctl : control the cpp options, files and namelist values 13 !!---------------------------------------------------------------------- 19 14 USE oce_trc 20 15 USE trc … … 25 20 PRIVATE 26 21 27 !! * Accessibility 28 PUBLIC trc_ctl 22 PUBLIC trc_ctl ! called by ??? 23 24 !!---------------------------------------------------------------------- 25 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 26 !! $Header:$ 27 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 28 !!---------------------------------------------------------------------- 29 29 30 30 CONTAINS 31 31 32 32 SUBROUTINE trc_ctl 33 !!=========================================================================================== 33 !!---------------------------------------------------------------------- 34 !! *** ROUTINE trc_ctl *** 34 35 !! 35 !! 36 !! ROUTINE trcctl 37 !! ****************** 38 !! 39 !! we use IF/ENDIF inside #IF defined option-cpp 40 !! FILE name must not exceed 21 characters 41 !! 42 !!=========================================================================================== 43 36 !! ** Purpose : control the cpp options, namelist and files 37 !! we use IF/ENDIF inside #IF defined option-cpp 38 !! FILE name must not exceed 21 characters 44 39 !!---------------------------------------------------------------------- 45 !! local declarations 46 !! ================== 47 INTEGER :: istop, jn 48 49 !!--------------------------------------------------------------------- 50 !! OPA.9 03/2005 51 !!--------------------------------------------------------------------- 40 INTEGER :: istop, jn 41 !!---------------------------------------------------------------------- 52 42 53 ! 0. Parameter54 ! ------------55 istop = 043 IF(lwp) WRITE(numout,*) 44 IF(lwp) WRITE(numout,*) ' trc_ctl : passive tracer option' 45 IF(lwp) WRITE(numout,*) ' ~~~~~~~' 56 46 57 ! 1. restart for passive tracer (input) 58 ! ----------------------------- 47 istop = 0 ! initialise to zero 59 48 60 IF(lwp) WRITE(numout,*) ' ' 61 IF(lwp) WRITE(numout,*) ' *** PASSIVE TRACER MODEL OPTIONS' 62 IF(lwp) WRITE(numout,*) ' *** CONTROL' 63 IF(lwp) WRITE(numout,*) ' ' 64 65 IF(lwp) WRITE(numout,*) ' ' 66 IF(lwp) WRITE(numout,*) ' *** restart option for passive tracer' 67 IF(lwp) WRITE(numout,*) ' ' 68 69 IF(lrsttr) THEN 70 IF(lwp) WRITE(numout,*) ' READ a restart FILE for passive tracer' 49 ! restart for passive tracer (input) 50 IF( lrsttr ) THEN 51 IF(lwp) WRITE(numout,*) ' READ a restart FILE for passive tracer' 71 52 IF(lwp) WRITE(numout,*) ' ' 72 53 ELSE 73 IF(lwp) WRITE(numout,*) ' no restart FILE' 74 IF(lwp) WRITE(numout,*) ' ' 75 76 ! 2. OPEN FILES for initial tracer value 77 ! -------------------------------------- 78 DO jn=1,jptra 79 80 ! OPEN input FILE only IF lutini(jn) is true 81 ! ------------------------------------------ 82 IF (lutini(jn)) THEN 83 84 ! prepare input FILE name a 85 ! ------------------------- 54 IF(lwp) WRITE(numout,*) ' no restart FILE' 55 IF(lwp) WRITE(numout,*) 56 DO jn = 1, jptra 57 IF( lutini(jn) ) THEN ! OPEN input FILE only IF lutini(jn) is true 86 58 IF(lwp) WRITE(numout,*) & 87 ' READ an initial FILE for passive tracer number :',jn & 88 ,' traceur : ',ctrcnm(jn) 89 IF(lwp) WRITE(numout,*) ' ' 59 ' READ an initial FILE for passive tracer number :', jn, ' traceur : ', ctrcnm(jn) 90 60 END IF 91 61 END DO 92 62 ENDIF 93 63 94 ! 3. Don't USE non penetrative convective mixing option 95 ! it's not implemented for passive tracer 96 ! ----------------------------------------------------- 97 98 IF( ln_zdfnpc) THEN 64 ! Don't USE non penetrative convective mixing option 65 ! it's not implemented for passive tracer 66 IF( ln_zdfnpc ) THEN 99 67 IF(lwp) WRITE (numout,*) ' ===>>>> : w a r n i n g ' 100 68 IF(lwp) WRITE (numout,*) ' ======= ============= ' … … 105 73 ENDIF 106 74 107 ! 4. transport scheme option 108 ! -------------------------- 109 110 IF(lwp) WRITE(numout,*) ' ' 75 ! transport scheme option 111 76 CALL trc_trp_ctl 112 77 113 114 ! 5. SMS model 115 ! --------------------------------------------- 116 78 ! SMS model 117 79 IF(lwp) WRITE(numout,*) ' ' 118 IF(lwp) WRITE(numout,*) ' ***Source/Sink model option'80 IF(lwp) WRITE(numout,*) ' Source/Sink model option' 119 81 IF(lwp) WRITE(numout,*) ' ' 120 82 83 # if defined key_lobster 84 # include "trcctl.lobster.h90" 121 85 122 #if defined key_trc_lobster1 123 # include "trcctl.lobster1.h90" 124 #elif defined key_trc_pisces 86 # elif defined key_pisces 125 87 # include "trcctl.pisces.h90" 126 #elif defined key_cfc 88 89 # elif defined key_cfc 127 90 # include "trcctl.cfc.h90" 128 #else129 91 130 IF(lwp) WRITE (numout,*) ' No Source/Sink model ' 131 IF(lwp) WRITE (numout,*) ' ' 92 # else 93 IF(lwp) WRITE (numout,*) ' No Source/Sink ' 94 IF(lwp) WRITE (numout,*) 132 95 #endif 133 96 134 97 ! E r r o r control 135 98 ! ------------------ 136 137 IF ( istop > 0 ) THEN 99 IF( istop > 0 ) THEN 138 100 IF(lwp)WRITE(numout,*) 139 101 IF(lwp)WRITE(numout,*) istop,' E R R O R found : we stop' 140 IF(lwp)WRITE(numout,*) ' **************************'102 IF(lwp)WRITE(numout,*) ' **************************' 141 103 IF(lwp)WRITE(numout,*) 142 104 STOP 'trcctl' 143 105 ENDIF 144 106 ! 145 107 END SUBROUTINE trc_ctl 146 108 147 109 #else 148 !! ======================================================================149 !! Empty module : No passive tracer150 !! ======================================================================110 !!---------------------------------------------------------------------- 111 !! Empty module : No passive tracer 112 !!---------------------------------------------------------------------- 151 113 CONTAINS 152 SUBROUTINE trc_ctl 153 114 SUBROUTINE trc_ctl ! Dummy routine 154 115 END SUBROUTINE trc_ctl 155 156 116 #endif 157 117 118 !!====================================================================== 158 119 END MODULE trcctl -
trunk/NEMO/TOP_SRC/trcdia.F90
r719 r945 1 1 MODULE trcdia 2 !!========================================================================== 3 !! 2 !!====================================================================== 4 3 !! *** MODULE trcdia *** 5 !! Output for tracer concentration 6 !! O.Aumont and A.El Moussaoui 03/05 F90 7 !!========================================================================== 8 !! TOP 1.0, LOCEAN-IPSL (2005) 9 !! $Header$ 10 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 4 !! TOP : Output of passive tracers 5 !!====================================================================== 6 !! History : 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) original code 11 7 !!---------------------------------------------------------------------- 12 #if defined key_ passivetrc8 #if defined key_top 13 9 !!---------------------------------------------------------------------- 14 !! * Modules used 15 10 !! 'key_top' TOP models 11 !!---------------------------------------------------------------------- 12 !! trc_dia : output passive tracer fields 13 !!---------------------------------------------------------------------- 16 14 USE trcdit 17 15 … … 19 17 PRIVATE 20 18 21 !! * Accessibility 22 PUBLIC trc_dia 19 PUBLIC trc_dia ! called by ??? 23 20 24 !! * Module variables 21 !!---------------------------------------------------------------------- 22 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 23 !! $Header:$ 24 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 25 !!---------------------------------------------------------------------- 25 26 26 27 CONTAINS 27 28 28 SUBROUTINE trc_dia(kt,kindic) 29 !!=========================================================================================== 29 SUBROUTINE trc_dia( kt, kindic ) 30 !!--------------------------------------------------------------------- 31 !! *** ROUTINE trc_dia *** 30 32 !! 31 !! ROUTINE trcdii_wr 32 !!=========================================================================================== 33 !! ** Purpose : output passive tracers fields 34 !!--------------------------------------------------------------------- 35 INTEGER, INTENT( in ) :: kt, kindic 36 !!--------------------------------------------------------------------- 37 38 CALL trcdit_wr( kt, kindic ) ! outputs for tracer concentration 33 39 34 INTEGER, INTENT( in ) :: kt, kindic 40 # if defined key_trc_diatrd 41 CALL trcdid_wr( kt, kindic ) ! outputs for dynamical trends 42 # endif 35 43 36 ! outputs for tracer concentration 37 ! -------------------------------- 44 # if defined key_trc_diaadd 45 CALL trcdii_wr( kt, kindic ) ! outputs for additional arrays 46 # endif 38 47 39 CALL trcdit_wr(kt,kindic) 40 41 #if defined key_trc_diatrd 42 43 ! outputs for dynamical trends 44 ! ---------------------------- 45 46 CALL trcdid_wr(kt,kindic) 47 48 #endif 49 #if defined key_trc_diaadd 50 51 ! outputs for additional arrays 52 ! ----------------------------- 53 54 CALL trcdii_wr(kt,kindic) 55 56 #endif 57 #if defined key_trc_diabio 58 59 ! outputs for biological trends 60 ! ----------------------------- 61 62 CALL trcdib_wr(kt,kindic) 63 64 #endif 65 48 # if defined key_trc_diabio 49 CALL trcdib_wr( kt, kindic ) ! outputs for biological trends 50 # endif 51 ! 66 52 END SUBROUTINE trc_dia 67 53 68 54 #else 69 !! ======================================================================70 !! Empty module :No passive tracer71 !! ======================================================================55 !!---------------------------------------------------------------------- 56 !! Dummy module : No passive tracer 57 !!---------------------------------------------------------------------- 72 58 CONTAINS 73 SUBROUTINE trc_dia 74 59 SUBROUTINE trc_dia ! Empty routine 75 60 END SUBROUTINE trc_dia 76 61 #endif 77 62 63 !!====================================================================== 78 64 END MODULE trcdia -
trunk/NEMO/TOP_SRC/trcdit.F90
r724 r945 1 1 MODULE trcdit 2 !!====================================================================== 3 !! *** MODULE trcdit *** 4 !! TOP : Output of passive tracers 5 !! O.Aumont and A.El Moussaoui 03/05 F90 6 !!====================================================================== 7 !! History : - ! 1995-01 (M. Levy) Original code 8 !! - ! 1998-01 (C. Levy) NETCDF format using ioipsl interface 9 !! - ! 1999-01 (M.A. Foujols) adapted for passive tracer 10 !! - ! 1999-09 (M.A. Foujols) split into three parts 11 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 2 12 !!---------------------------------------------------------------------- 3 !! TOP 1.0, LOCEAN-IPSL (2005) 4 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcdit.F90,v 1.9 2007/10/12 09:22:19 opalod Exp $ 5 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 13 #if defined key_top 6 14 !!---------------------------------------------------------------------- 7 !! * Modules used 8 !! ============== 15 !! 'key_top' TOP models 16 !!---------------------------------------------------------------------- 17 !! trcdit_wr : 18 !! trcdid_wr : 19 !! trcdii_wr : 20 !! trcdib_wr : 21 !!---------------------------------------------------------------------- 9 22 USE oce_trc 10 23 USE trc … … 12 25 USE in_out_manager ! I/O manager 13 26 USE lib_mpp 27 USE ioipsl 14 28 15 29 IMPLICIT NONE 16 30 PRIVATE 17 31 18 !! * Accessibility 19 PUBLIC trcdit_wr 20 PUBLIC trcdid_wr 21 PUBLIC trcdii_wr 22 PUBLIC trcdib_wr 23 24 !! * Module variables 25 INTEGER :: & 26 nit5 , & !!: id for tracer output file 27 ndepit5 , & !!: id for depth mesh 28 nhorit5 , & !!: id for horizontal mesh 29 ndimt50 , & !!: number of ocean points in index array 30 ndimt51 !!: number of ocean points in index array 31 REAL(wp) :: zjulian 32 INTEGER , DIMENSION (jpij*jpk) :: ndext50 !!: integer arrays for ocean 3D index 33 INTEGER , DIMENSION (jpij) :: ndext51 !!: integer arrays for ocean surface index 34 # if defined key_passivetrc && defined key_trc_diaadd 35 INTEGER :: & 36 nitd , & !!: id for additional array output file 37 ndepitd , & !!: id for depth mesh 38 nhoritd !!: id for horizontal mesh 39 # endif 40 # if defined key_passivetrc && defined key_trc_diatrd 41 INTEGER , DIMENSION (jptra) :: & 42 nit6 , & !!: id for additional array output file 43 ndepit6 , & !!: id for depth mesh 44 nhorit6 !!: id for horizontal mesh 45 # endif 46 # if defined key_passivetrc && defined key_trc_diabio 47 INTEGER :: & 48 nitb , & !!: id for additional array output FILE 49 ndepitb , & !!: id for depth mesh 50 nhoritb !!: id for horizontal mesh 51 52 # endif 53 32 PUBLIC trcdit_wr ! caller in trcdia.F90 33 PUBLIC trcdid_wr ! caller in trcdia.F90 34 PUBLIC trcdii_wr ! caller in trcdia.F90 35 PUBLIC trcdib_wr ! caller in trcdia.F90 36 37 INTEGER :: nit5 !: id for tracer output file 38 INTEGER :: ndepit5 !: id for depth mesh 39 INTEGER :: nhorit5 !: id for horizontal mesh 40 INTEGER :: ndimt50 !: number of ocean points in index array 41 INTEGER :: ndimt51 !: number of ocean points in index array 42 REAL(wp) :: zjulian !: ???? not DOCTOR ! 43 INTEGER , DIMENSION (jpij*jpk) :: ndext50 !: integer arrays for ocean 3D index 44 INTEGER , DIMENSION (jpij) :: ndext51 !: integer arrays for ocean surface index 45 # if defined key_trc_diaadd 46 INTEGER :: nitd !: id for additional array output file 47 INTEGER :: ndepitd !: id for depth mesh 48 INTEGER :: nhoritd !: id for horizontal mesh 49 # endif 50 # if defined key_trc_diatrd 51 INTEGER , DIMENSION (jptra) :: nit6 !: id for additional array output file 52 INTEGER , DIMENSION (jptra) :: ndepit6 !: id for depth mesh 53 INTEGER , DIMENSION (jptra) :: nhorit6 !: id for horizontal mesh 54 # endif 55 # if defined key_trc_diabio 56 INTEGER :: ndepitb !: id for depth mesh 57 INTEGER :: nhoritb !: id for horizontal mesh 58 # endif 54 59 55 60 !! * Substitutions 56 # include "passivetrc_substitute.h90" 61 # include "top_substitute.h90" 62 !!---------------------------------------------------------------------- 63 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 64 !! $Header:$ 65 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 66 !!---------------------------------------------------------------------- 57 67 58 68 CONTAINS 59 69 60 # if defined key_passivetrc 61 62 SUBROUTINE trcdit_wr(kt,kindic) 63 !!=========================================================================================== 64 !! 65 !! ROUTINE trcdit_wr 66 !!=========================================================================================== 67 !! 68 !! Purpose : 69 !!--------- 70 !! Standard output of passive tracer : concentration fields 71 !! 72 !! 73 !! Method : 74 !! ------- 75 !! 76 !! At the beginning of the first time step (nit000), define all 77 !! the NETCDF files and fields for concentration of passive tracer 78 !! 79 !! At each time step call histdef to compute the mean if necessary 80 !! Each nwritetrc time step, output the instantaneous or mean fields 81 !! 82 !! IF kindic <0, output of fields before the model interruption. 83 !! IF kindic =0, time step loop 84 !! IF kindic >0, output of fields before the time step loop 85 !! 86 !! Input : 87 !! ----- 88 !! argument 89 !! kt : time step 90 !! kindic : indicator of abnormal termination 91 !! 92 !! EXTERNAL : 93 !! -------- 94 !! prihre, hist..., dianam 95 !! 96 !! History: 97 !! -------- 98 !! original : 95-01 passive tracers (M. Levy) 99 !! additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 100 !! additions : 99-01 (M.A. Foujols) adapted for passive tracer 101 !! additions : 99-09 (M.A. Foujols) split into three parts 102 !! 05-03 (O. Aumont and A. El Moussaoui) F90 103 !!==================================================================================================! 104 105 !! Modules used 106 USE ioipsl 107 108 109 !! * Arguments 110 INTEGER, INTENT( in ) :: kt,kindic ! ocean time-step 111 112 !! * Local declarations 113 INTEGER :: jn 114 LOGICAL :: ll_print = .FALSE. 115 70 SUBROUTINE trcdit_wr( kt, kindic ) 71 !!---------------------------------------------------------------------- 72 !! *** ROUTINE trcdit_wr *** 73 !! 74 !! ** Purpose : Standard output of passive tracer : concentration fields 75 !! 76 !! ** Method : At the beginning of the first time step (nit000), define all 77 !! the NETCDF files and fields for concentration of passive tracer 78 !! 79 !! At each time step call histdef to compute the mean if necessary 80 !! Each nwritetrc time step, output the instantaneous or mean fields 81 !! 82 !! IF kindic <0, output of fields before the model interruption. 83 !! IF kindic =0, time step loop 84 !! IF kindic >0, output of fields before the time step loop 85 !!---------------------------------------------------------------------- 86 INTEGER, INTENT( in ) :: kt ! ocean time-step 87 INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination 88 !! 89 INTEGER :: jn 90 LOGICAL :: ll_print = .FALSE. 116 91 CHARACTER (len=40) :: clhstnam, clop 117 92 CHARACTER (len=20) :: cltra, cltrau 118 93 CHARACTER (len=80) :: cltral 119 120 94 REAL(wp) :: zsto, zout, zdt 121 95 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 122 ! 123 ! 0. Initialisation 124 ! ----------------- 125 126 ! local variable for debugging 127 ll_print = .FALSE. 96 !!---------------------------------------------------------------------- 97 98 ! Initialisation 99 ! -------------- 100 101 ! local variable for debugging 102 ll_print = .FALSE. ! change it to true for more control print 128 103 ll_print = ll_print .AND. lwp 129 104 130 ! Define frequency of output and means 131 105 ! Define frequency of output and means 132 106 zdt = rdt 133 # 134 zsto =nwritetrc*rdt135 clop ='inst(only(x))'136 # 137 zsto =zdt138 clop ='ave(only(x))'139 # 140 zout =nwritetrc*zdt107 # if defined key_diainstant 108 zsto = nwritetrc * rdt 109 clop = 'inst(only(x))' 110 # else 111 zsto = zdt 112 clop = 'ave(only(x))' 113 # endif 114 zout = nwritetrc * zdt 141 115 142 116 ! Define indices of the horizontal output zoom and vertical limit storage … … 148 122 it = kt - nittrc000 + 1 149 123 150 ! 1.Define NETCDF files and fields at beginning of first time step151 ! -----------------------------------------------------------------124 ! Define NETCDF files and fields at beginning of first time step 125 ! -------------------------------------------------------------- 152 126 153 127 IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 154 IF(kt == nittrc000) THEN155 156 ! Compute julian date from starting date of the run 157 158 CALL ymds2ju( nyear,nmonth,nday,0.0,zjulian)128 129 IF( kt == nittrc000 ) THEN 130 131 ! Compute julian date from starting date of the run 132 CALL ymds2ju( nyear, nmonth, nday, 0.0, zjulian ) 159 133 IF(lwp)WRITE(numout,*)' ' 160 IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000&161 & ,' YEAR ',nyear,' MONTH ',nmonth,' DAY ',nday &162 & ,'Julian day : ',zjulian163 IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, &164 134 IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000 & 135 & ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday & 136 & ,'Julian day : ', zjulian 137 IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & 138 & ' limit storage in depth = ', ipk 165 139 166 140 167 141 ! Define the NETCDF files for passive tracer concentration 168 142 169 CALL dia_nam(clhstnam,nwritetrc,'ptrc_T') 170 143 CALL dia_nam( clhstnam, nwritetrc, 'ptrc_T' ) 171 144 IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam 172 145 ! Horizontal grid : glamt and gphit 173 174 CALL histbeg(clhstnam, jpi, glamt, jpj, gphit, & 175 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 176 & 0, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 146 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 147 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 148 & 0, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 177 149 ! Vertical grid for tracer : gdept 178 CALL histvert( nit5, 'deptht', 'Vertical T levels', &179 &'m', ipk, gdept_0, ndepit5)150 CALL histvert( nit5, 'deptht', 'Vertical T levels', & 151 & 'm', ipk, gdept_0, ndepit5) 180 152 181 153 ! Index of ocean points in 3D and 2D (surface) 182 CALL wheneq( jpi*jpj*ipk,tmask,1,1.,ndext50,ndimt50)183 CALL wheneq( jpi*jpj,tmask,1,1.,ndext51,ndimt51)154 CALL wheneq( jpi*jpj*ipk,tmask,1,1.,ndext50,ndimt50 ) 155 CALL wheneq( jpi*jpj,tmask,1,1.,ndext51,ndimt51 ) 184 156 185 157 ! Declare all the output fields as NETCDF variables 186 158 187 159 ! tracer concentrations 188 189 DO jn=1,jptra 190 cltra=ctrcnm(jn) ! short title for tracer 191 cltral=ctrcnl(jn) ! long title for tracer 192 cltrau=ctrcun(jn) ! UNIT for tracer 193 CALL histdef(nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5, & 194 & ipk, 1, ipk, ndepit5, 32, clop, zsto, zout) 195 END DO 196 197 ! CLOSE netcdf Files 198 199 CALL histend(nit5) 200 160 DO jn = 1, jptra 161 IF( lutsav(jn) ) THEN 162 cltra = ctrcnm(jn) ! short title for tracer 163 cltral = ctrcnl(jn) ! long title for tracer 164 cltrau = ctrcun(jn) ! UNIT for tracer 165 CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5, & 166 & ipk, 1, ipk, ndepit5, 32, clop, zsto, zout) 167 ENDIF 168 END DO 169 170 ! end netcdf files header 171 CALL histend( nit5 ) 201 172 IF(lwp) WRITE(numout,*) 202 173 IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdit_wr' 203 IF(ll_print) CALL FLUSH(numout ) 204 205 ENDIF 206 207 ! 2. Start writing data 208 ! --------------------- 209 210 ! tracer concentrations 174 IF( ll_print ) CALL FLUSH(numout ) 175 176 ENDIF 177 178 ! Start writing the tracer concentrations 179 ! --------------------------------------- 211 180 212 181 IF( lwp .AND. MOD( kt, nwritetrc ) == 0 ) THEN 213 182 WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step' 214 WRITE(numout,*) '~~~~~~ ' 215 ENDIF 216 217 DO jn=1,jptra 218 cltra=ctrcnm(jn) ! short title for tracer 219 CALL histwrite(nit5, cltra, it, trn(:,:,:,jn), ndimt50, & 220 & ndext50) 221 END DO 222 223 ! synchronise FILE 224 225 IF( MOD( kt, nwritetrc ) == 0 .OR. kindic < 0 ) THEN 226 CALL histsync(nit5) 227 ENDIF 228 229 ! 3. Closing all files 230 ! -------------------- 231 IF( kt == nitend .OR. kindic < 0 ) THEN 232 CALL histclo(nit5) 233 ENDIF 234 235 END SUBROUTINE trcdit_wr 236 237 # else 238 239 ! no passive tracers 240 241 SUBROUTINE trcdit_wr(kt,kindic) 242 !!! no passive tracers 243 INTEGER, INTENT ( in ) :: kt, kindic 244 WRITE(*,*) 'trcdit_wr: You should not have seen this print! error?', kt, kindic 245 END SUBROUTINE trcdit_wr 246 247 # endif 248 249 # if defined key_passivetrc && defined key_trc_diatrd 250 251 SUBROUTINE trcdid_wr(kt,kindic) 252 !!=========================================================================================== 253 !! 254 !! ROUTINE trcdid_wr 255 !!=========================================================================================== 256 !! 257 !! Purpose : 258 !!--------- 259 !! output of opa: passive tracer dynamical trends 260 !! 261 !! 262 !! Method : 263 !! ------- 264 !! 265 !! At the beginning of the first time step (nit000), define all 266 !! the NETCDF files and fields for dynamical trends of tracers 267 !! 268 !! At each time step call histdef to compute the mean if necessary 269 !! Each nwritetrd time step, output the instantaneous or mean fields 270 !! 271 !! IF kindic <0, output of fields before the model interruption. 272 !! IF kindic =0, time step loop 273 !! IF kindic >0, output of fields before the time step loop 274 !! 275 !! Input : 276 !! ----- 277 !! argument 278 !! kt : time step 279 !! kindic : indicator of abnormal termination 280 !! 281 !! Output : 282 !! ------ 283 !! file 284 !! "clhstnam" files : one for concentration 285 !! 286 !! History: 287 !! -------- 288 !! original : 95-01 passive tracers (M. Levy) 289 !! additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 290 !! additions : 99-01 (M.A. Foujols) adapted for passive tracer 291 !! additions : 99-09 (M.A. Foujols) split into three parts 292 !! additions : 01-06 (Mehdi B, Elodie K): suppress initialization 293 !! of nit6,nhorit6,ndepit6 294 !! 05-03 (O. Aumont and A. El Moussaoui) F90 295 !!==================================================================================================! 296 297 !! Modules used 298 USE ioipsl 299 300 !! * Arguments 301 INTEGER, INTENT( in ) :: kt,kindic ! ocean time-step 302 303 INTEGER :: jn, jl 304 LOGICAL :: ll_print = .FALSE. 305 306 CHARACTER (len=40) :: clhstnam, clop 307 CHARACTER (len=20) :: cltra, cltrau 308 CHARACTER (len=80) :: cltral 309 CHARACTER (len=10) :: csuff 310 311 REAL(wp) :: zsto, zout, zdt 312 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 313 314 ! 315 ! 0. Initialisation 316 ! ----------------- 317 318 ! local variable for debugging 183 WRITE(numout,*) '~~~~~~~~~ ' 184 ENDIF 185 186 DO jn = 1, jptra 187 IF( lutsav(jn) ) THEN 188 cltra = ctrcnm(jn) ! short title for tracer 189 CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 190 ENDIF 191 END DO 192 193 ! synchronise file 194 IF( MOD( kt, nwritetrc ) == 0 .OR. kindic < 0 ) CALL histsync( nit5 ) 195 196 197 ! close the file 198 ! -------------- 199 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nit5 ) 200 ! 201 END SUBROUTINE trcdit_wr 202 203 # if defined key_trc_diatrd 204 205 SUBROUTINE trcdid_wr( kt, kindic ) 206 !!---------------------------------------------------------------------- 207 !! *** ROUTINE trcdid_wr *** 208 !! 209 !! ** Purpose : output of passive tracer : advection-diffusion trends 210 !! 211 !! ** Method : At the beginning of the first time step (nit000), define all 212 !! the NETCDF files and fields for concentration of passive tracer 213 !! 214 !! At each time step call histdef to compute the mean if necessary 215 !! Each nwritetrc time step, output the instantaneous or mean fields 216 !! 217 !! IF kindic <0, output of fields before the model interruption. 218 !! IF kindic =0, time step loop 219 !! IF kindic >0, output of fields before the time step loop 220 !!---------------------------------------------------------------------- 221 INTEGER, INTENT( in ) :: kt ! ocean time-step 222 INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination 223 !! 224 LOGICAL :: ll_print = .FALSE. 225 CHARACTER (len=40) :: clhstnam, clop 226 CHARACTER (len=20) :: cltra, cltrau 227 CHARACTER (len=80) :: cltral 228 CHARACTER (len=10) :: csuff 229 INTEGER :: jn, jl 230 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 231 REAL(wp) :: zsto, zout, zdt 232 !!---------------------------------------------------------------------- 233 234 ! 0. Initialisation 235 ! ----------------- 236 237 ! local variable for debugging 319 238 ll_print = .FALSE. 320 239 ll_print = ll_print .AND. lwp 321 ! 322 ! Define frequency of output and means 323 ! 240 ! 241 ! Define frequency of output and means 324 242 zdt = rdt 325 # 326 zsto =nwritetrd*rdt327 clop ='inst(only(x))'328 # 329 zsto =zdt330 clop ='ave(only(x))'331 # 332 zout =nwritetrd*zdt243 # if defined key_diainstant 244 zsto = nwritetrd * rdt 245 clop = 'inst(only(x))' 246 # else 247 zsto = zdt 248 clop = 'ave(only(x))' 249 # endif 250 zout = nwritetrd * zdt 333 251 334 252 ! Define indices of the horizontal output zoom and vertical limit storage … … 340 258 it = kt - nittrc000 + 1 341 259 342 ! Define the NETCDF files (one per tracer) 343 ! 344 IF(ll_print)WRITE(numout,*)'trcdid kt=',kt,' kindic ',kindic 345 IF(kt == nittrc000) THEN 346 347 DO jn=1,jptra 348 349 IF (luttrd(jn)) THEN 350 351 ! Define the file for dynamical trends - one per each tracer IF required 352 353 IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & 354 ' limit storage in depth = ', ipk 355 csuff='DY_'//ctrcnm(jn) 356 CALL dia_nam(clhstnam,nwritetrd,csuff) 357 IF(lwp)WRITE(numout,*) & 358 & " Name of NETCDF file for dynamical trends", & 359 & " of tracer number : ",clhstnam 360 361 CALL histbeg(clhstnam, jpi, glamt, jpj, gphit, & 362 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 363 & 0, zjulian, rdt, nhorit6(jn), & 364 & nit6(jn) , domain_id=nidom) 365 366 ! Vertical grid for tracer trend - one per each tracer IF needed 367 CALL histvert(nit6(jn), 'deptht', 'Vertical T levels', & 368 & 'm', ipk, gdept_0, ndepit6(jn)) 369 370 371 END IF 260 ! Define the NETCDF files (one per tracer) 261 IF( ll_print ) WRITE(numout,*) 'trcdid kt=', kt, ' kindic ', kindic 262 263 264 IF( kt == nittrc000 ) THEN 265 266 DO jn = 1, jptra 267 ! 268 IF( luttrd(jn) ) THEN ! Define the file for dynamical trends - one per each tracer IF required 269 270 IF(lwp)WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & 271 & ' limit storage in depth = ', ipk 272 csuff='DY_'//ctrcnm(jn) 273 CALL dia_nam( clhstnam, nwritetrd, csuff ) 274 IF(lwp)WRITE(numout,*) " Name of NETCDF file for dynamical trends", & 275 & " of tracer number : ",clhstnam 276 277 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 278 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 279 & 0, zjulian, rdt, nhorit6(jn), & 280 & nit6(jn) , domain_id=nidom ) 281 282 ! Vertical grid for tracer trend - one per each tracer IF needed 283 CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', & 284 & 'm', ipk, gdept_0, ndepit6(jn) ) 285 END IF 372 286 END DO 373 287 374 ! Declare all the output fields as NETCDF variables 375 376 377 ! trends for tracer concentrations 378 DO jn=1,jptra 379 IF (luttrd(jn)) THEN 380 DO jl=1,jpdiatrc 381 IF (jl.eq.1) THEN 382 ! short and long title for x advection for tracer 288 ! Declare all the output fields as NETCDF variables 289 290 ! trends for tracer concentrations 291 DO jn = 1, jptra 292 IF( luttrd(jn) ) THEN 293 DO jl = 1, jpdiatrc 294 IF( jl == 1 ) THEN 295 ! short and long title for x advection for tracer 383 296 WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 384 297 WRITE (cltral,'("X advective trend for ",58a)') & 385 & ctrcnl(jn)(1:58)386 END IF 387 IF (jl.eq.2)THEN388 ! short and long title for y advection for tracer298 & ctrcnl(jn)(1:58) 299 END IF 300 IF( jl == 2 ) THEN 301 ! short and long title for y advection for tracer 389 302 WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 390 303 WRITE (cltral,'("Y advective trend for ",58a)') & 391 & ctrcnl(jn)(1:58)392 END IF 393 IF (jl.eq.3)THEN394 ! short and long title for Z advection for tracer304 & ctrcnl(jn)(1:58) 305 END IF 306 IF( jl == 3 ) THEN 307 ! short and long title for Z advection for tracer 395 308 WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 396 309 WRITE (cltral,'("Z advective trend for ",58a)') & 397 & ctrcnl(jn)(1:58)398 END IF 399 IF (jl.eq.4)THEN400 ! short and long title for X diffusion for tracer310 & ctrcnl(jn)(1:58) 311 END IF 312 IF( jl == 4 ) THEN 313 ! short and long title for X diffusion for tracer 401 314 WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 402 315 WRITE (cltral,'("X diffusion trend for ",58a)') & 403 & ctrcnl(jn)(1:58)404 END IF 405 IF (jl.eq.5)THEN406 ! short and long title for Y diffusion for tracer316 & ctrcnl(jn)(1:58) 317 END IF 318 IF( jl == 5 ) THEN 319 ! short and long title for Y diffusion for tracer 407 320 WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 408 321 WRITE (cltral,'("Y diffusion trend for ",58a)') & 409 & ctrcnl(jn)(1:58)410 END IF 411 IF (jl.eq.6)THEN412 ! short and long title for Z diffusion for tracer322 & ctrcnl(jn)(1:58) 323 END IF 324 IF( jl == 6 ) THEN 325 ! short and long title for Z diffusion for tracer 413 326 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 414 327 WRITE (cltral,'("Z diffusion trend for ",58a)') & 415 & ctrcnl(jn)(1:58)328 & ctrcnl(jn)(1:58) 416 329 END IF 417 330 # if defined key_trc_ldfeiv 418 IF (jl.eq.7) THEN419 ! short and long title for x gent velocity for tracer331 IF( jl == 7 ) THEN 332 ! short and long title for x gent velocity for tracer 420 333 WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 421 334 WRITE (cltral,'("X gent velocity trend for ",53a)') & 422 & ctrcnl(jn)(1:53)423 END IF 424 IF (jl.eq.8)THEN425 ! short and long title for y gent velocity for tracer335 & ctrcnl(jn)(1:53) 336 END IF 337 IF( jl == 8 ) THEN 338 ! short and long title for y gent velocity for tracer 426 339 WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 427 340 WRITE (cltral,'("Y gent velocity trend for ",53a)') & 428 & ctrcnl(jn)(1:53)429 END IF 430 IF (jl.eq.9)THEN431 ! short and long title for Z gent velocity for tracer341 & ctrcnl(jn)(1:53) 342 END IF 343 IF( jl == 9 ) THEN 344 ! short and long title for Z gent velocity for tracer 432 345 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 433 346 WRITE (cltral,'("Z gent velocity trend for ",53a)') & 434 & ctrcnl(jn)(1:53)347 & ctrcnl(jn)(1:53) 435 348 END IF 436 349 # endif 437 350 # if defined key_trcdmp 438 IF (jl.eq.jpdiatrc-1)THEN439 ! last trends for tracer damping : short and long title351 IF( jl == jpdiatrc - 1 ) THEN 352 ! last trends for tracer damping : short and long title 440 353 WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 441 354 WRITE (cltral,'("Tracer damping trend for ",55a)') & 442 & ctrcnl(jn)(1:55)443 END IF 444 # endif 445 IF (jl.eq.jpdiatrc)THEN446 ! last trends for tracer damping : short and long title355 & ctrcnl(jn)(1:55) 356 END IF 357 # endif 358 IF( jl == jpdiatrc ) THEN 359 ! last trends for tracer damping : short and long title 447 360 WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 448 361 WRITE (cltral,'("Surface boundary flux ",58a)') & … … 450 363 END IF 451 364 452 call flush(numout)453 cltrau =ctrcun(jn)! UNIT for tracer /trends454 CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj, &455 &nhorit6(jn), ipk, 1, ipk, ndepit6(jn), 32, clop , &456 & zsto,zout)457 365 CALL FLUSH( numout ) 366 cltrau = ctrcun(jn) ! UNIT for tracer /trends 367 CALL histdef( nit6(jn), cltra, cltral, cltrau, jpi,jpj, & 368 & nhorit6(jn), ipk, 1, ipk, ndepit6(jn), 32, clop , & 369 & zsto,zout ) 370 END DO 458 371 END IF 459 END DO 460 461 ! CLOSE netcdf Files 462 463 DO jn=1,jptra 464 IF (luttrd(jn)) CALL histend(nit6(jn)) 372 END DO 373 374 ! CLOSE netcdf Files 375 DO jn = 1, jptra 376 IF( luttrd(jn) ) CALL histend( nit6(jn) ) 465 377 END DO 466 378 … … 468 380 IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdid' 469 381 IF(ll_print) CALL FLUSH(numout ) 470 471 ENDIF 472 473 ! SOME diagnostics to DO first time474 475 ! 2.Start writing data476 ! ---------------------477 478 ! trends for tracer concentrations382 ! 383 ENDIF 384 385 ! SOME diagnostics to DO first time 386 387 ! Start writing data 388 ! --------------------- 389 390 ! trends for tracer concentrations 479 391 480 392 IF( lwp .AND. MOD( kt, nwritetrd ) == 0 ) THEN … … 483 395 ENDIF 484 396 485 DO jn=1,jptra 486 IF (luttrd(jn)) THEN 487 DO jl=1,jpdiatrc 488 IF (jl.eq.1) THEN 489 ! short title for x advection for tracer 490 WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 491 END IF 492 IF (jl.eq.2) THEN 493 ! short title for y advection for tracer 494 WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 495 END IF 496 IF (jl.eq.3) THEN 497 ! short title for z advection for tracer 498 WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 499 END IF 500 IF (jl.eq.4) THEN 501 ! short title for x diffusion for tracer 502 WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 503 END IF 504 IF (jl.eq.5) THEN 505 ! short title for y diffusion for tracer 506 WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 507 END IF 508 IF (jl.eq.6) THEN 509 ! short title for z diffusion for tracer 510 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 511 END IF 397 DO jn = 1, jptra 398 IF( luttrd(jn) ) THEN 399 DO jl = 1, jpdiatrc 400 ! short titles 401 IF( jl == 1) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) ! x advection for tracer 402 IF( jl == 2) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) ! z advection for tracer 403 IF( jl == 3) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) ! z advection for tracer 404 IF( jl == 4) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) ! x diffusion for tracer 405 IF( jl == 5) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) ! y diffusion for tracer 406 IF( jl == 6) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) ! z diffusion for tracer 512 407 # if defined key_trcldf_eiv 513 IF (jl.eq.7) THEN 514 ! short for x gent velocity for tracer 515 WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 516 END IF 517 IF (jl.eq.8) THEN 518 ! short for y gent velocity for tracer 519 WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 520 END IF 521 IF (jl.eq.9) THEN 522 ! short title for Z gent velocity for tracer 523 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 524 END IF 408 IF( jl == 7) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) ! x gent velocity for tracer 409 IF( jl == 8) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) ! y gent velocity for tracer 410 IF( jl == 9) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) ! z gent velocity for tracer 525 411 # endif 526 412 # if defined key_trcdmp 527 IF (jl.eq.jpdiatrc-1) THEN 528 ! short for x gent velocity for tracer 529 WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 530 END IF 531 # endif 532 IF (jl.eq.jpdiatrc) THEN 533 ! short for surface boundary conditions for tracer 534 WRITE (cltra,'("SBC_",a)') ctrcnm(jn) 535 END IF 536 537 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl) & 538 & ,ndimt50, ndext50) 539 END DO 540 END IF 541 END DO 542 543 ! synchronise FILE 544 413 IF( jl == jpdiatrc - 1 ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) ! damping 414 # endif 415 IF( jl == jpdiatrc ) WRITE (cltra,'("SBC_",a)') ctrcnm(jn) ! surface boundary conditions 416 ! 417 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl) & 418 & ,ndimt50, ndext50) 419 END DO 420 END IF 421 END DO 422 423 ! synchronise FILE 545 424 IF( MOD( kt, nwritetrd ) == 0 .OR. kindic < 0 ) THEN 546 DO jn=1,jptra 547 IF (luttrd(jn)) CALL histsync(nit6(jn)) 548 END DO 549 ENDIF 550 551 ! 3. Closing all files 552 ! -------------------- 553 425 DO jn = 1, jptra 426 IF (luttrd(jn)) CALL histsync( nit6(jn) ) 427 END DO 428 ENDIF 429 430 ! Closing all files 431 ! ----------------- 554 432 IF( kt == nitend .OR. kindic < 0 ) THEN 555 DO jn=1,jptra 556 IF (luttrd(jn)) CALL histclo(nit6(jn)) 557 END DO 558 ENDIF 559 560 END SUBROUTINE trcdid_wr 561 562 # else 563 564 SUBROUTINE trcdid_wr(kt,kindic) 565 !!! no passive tracers 566 INTEGER, INTENT ( in ) :: kt, kindic 567 WRITE(*,*) 'trcdid_wr: You should not have seen this print! error?', kt, kindic 568 END SUBROUTINE trcdid_wr 569 570 # endif 571 572 # if defined key_passivetrc && defined key_trc_diaadd 573 574 SUBROUTINE trcdii_wr(kt,kindic) 575 !!=========================================================================================== 576 !! 577 !! ROUTINE trcdii_wr 578 !!=========================================================================================== 579 !! 580 !! Purpose : 581 !!--------- 582 !! output of passive tracer : additional 2D and 3D arrays 583 !! 584 !! 585 !! Method : 586 !! ------- 587 !! 588 !! At the beginning of the first time step (nit000), define all 589 !! the NETCDF files and fields for additional arrays 590 !! 591 !! At each time step call histdef to compute the mean if necessary 592 !! Each nwritetrc time step, output the instantaneous or mean fields 593 !! 594 !! 595 !! IF kindic <0, output of fields before the model interruption. 596 !! IF kindic =0, time step loop 597 !! IF kindic >0, output of fields before the time step loop 598 !! 599 !! Input : 600 !! ----- 601 !! argument 602 !! kt : time step 603 !! kindic : indicator of abnormal termination 604 !! 605 !! EXTERNAL : 606 !! -------- 607 !! prihre, hist..., dianam 608 !! 609 !! History: 610 !! -------- 611 !! original : 95-01 passive tracers (M. Levy) 612 !! additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 613 !! additions : 99-01 (M.A. Foujols) adapted for passive tracer 614 !! additions : 99-09 (M.A. Foujols) split into three parts 615 !! 05-03 (O. Aumont and A. El Moussaoui) F90 616 !!==================================================================================================! 617 618 !! Modules used 619 USE ioipsl 620 621 !! * Arguments 622 INTEGER, INTENT( in ) :: kt,kindic ! ocean time-step 623 624 INTEGER :: jn 625 LOGICAL :: ll_print = .FALSE. 626 627 CHARACTER (len=40) :: clhstnam, clop 628 CHARACTER (len=20) :: cltra, cltrau 629 CHARACTER (len=80) :: cltral 630 631 REAL(wp) :: zsto, zout, zdt 632 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 633 634 ! 635 ! 0. Initialisation 636 ! ----------------- 637 638 ! local variable for debugging 433 DO jn = 1, jptra 434 IF( luttrd(jn) ) CALL histclo( nit6(jn) ) 435 END DO 436 ENDIF 437 ! 438 END SUBROUTINE trcdid_wr 439 440 # else 441 SUBROUTINE trcdid_wr( kt, kindic ) ! Dummy routine 442 INTEGER, INTENT ( in ) :: kt, kindic 443 WRITE(*,*) 'trcdid_wr: You should not have seen this print! error?', kt, kindic 444 END SUBROUTINE trcdid_wr 445 # endif 446 447 # if defined key_top && defined key_trc_diaadd 448 449 SUBROUTINE trcdii_wr( kt, kindic ) 450 !!---------------------------------------------------------------------- 451 !! *** ROUTINE trcdii_wr *** 452 !! 453 !! ** Purpose : output of passive tracer : additional 2D and 3D arrays 454 !! 455 !! ** Method : At the beginning of the first time step (nit000), define all 456 !! the NETCDF files and fields for concentration of passive tracer 457 !! 458 !! At each time step call histdef to compute the mean if necessary 459 !! Each nwritetrc time step, output the instantaneous or mean fields 460 !! 461 !! IF kindic <0, output of fields before the model interruption. 462 !! IF kindic =0, time step loop 463 !! IF kindic >0, output of fields before the time step loop 464 !!---------------------------------------------------------------------- 465 INTEGER, INTENT( in ) :: kt ! ocean time-step 466 INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination 467 !! 468 LOGICAL :: ll_print = .FALSE. 469 CHARACTER (len=40) :: clhstnam, clop 470 CHARACTER (len=20) :: cltra, cltrau 471 CHARACTER (len=80) :: cltral 472 INTEGER :: jn 473 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 474 REAL(wp) :: zsto, zout, zdt 475 !!---------------------------------------------------------------------- 476 477 ! Initialisation 478 ! -------------- 479 480 ! local variable for debugging 639 481 ll_print = .FALSE. 640 482 ll_print = ll_print .AND. lwp 641 ! 642 ! Define frequency of output and means 643 ! 483 ! 484 ! Define frequency of output and means 644 485 zdt = rdt 645 # 646 zsto=nwrite add*zdt486 # if defined key_diainstant 487 zsto=nwritedia*zdt 647 488 clop='inst(only(x))' 648 # 489 # else 649 490 zsto=zdt 650 491 clop='ave(only(x))' 651 # 652 zout=nwrite add*zdt492 # endif 493 zout=nwritedia*zdt 653 494 654 495 ! Define indices of the horizontal output zoom and vertical limit storage … … 660 501 it = kt - nittrc000 + 1 661 502 662 ! 1. Define NETCDF files and fields at beginning of first time step 663 ! ----------------------------------------------------------------- 664 665 IF(ll_print)WRITE(numout,*)'trcdii_wr kt=',kt,' kindic ',kindic 666 IF(kt == nittrc000) THEN 667 668 ! Define the NETCDF files for additional arrays : 2D or 3D 669 670 ! Define the T grid file for tracer auxiliary files 671 672 CALL dia_nam(clhstnam,nwrite,'diad_T') 673 IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam 674 675 ! Define a netcdf FILE for 2d and 3d arrays 676 677 CALL histbeg(clhstnam, jpi, glamt, jpj, gphit, & 678 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 679 & 0, zjulian, zdt, nhoritd, nitd , domain_id=nidom) 680 681 ! Vertical grid for 2d and 3d arrays 682 683 CALL histvert(nitd, 'deptht', 'Vertical T levels', & 684 & 'm', ipk, gdept_0, ndepitd) 685 686 687 ! Declare all the output fields as NETCDF variables 688 689 ! more 3D horizontal arrays 690 691 DO jn=1,jpdia3d 692 cltra=ctrc3d(jn) ! short title for 3D diagnostic 693 cltral=ctrc3l(jn) ! long title for 3D diagnostic 694 cltrau=ctrc3u(jn) ! UNIT for 3D diagnostic 695 CALL histdef(nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 696 & ipk, 1, ipk, ndepitd, 32, clop, zsto, zout) 697 END DO 698 699 700 ! more 2D horizontal arrays 701 702 DO jn=1,jpdia2d 503 ! 1. Define NETCDF files and fields at beginning of first time step 504 ! ----------------------------------------------------------------- 505 506 IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 507 508 IF( kt == nittrc000 ) THEN 509 510 ! Define the NETCDF files for additional arrays : 2D or 3D 511 512 ! Define the T grid file for tracer auxiliary files 513 514 CALL dia_nam( clhstnam, nwrite, 'diad_T' ) 515 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 516 517 ! Define a netcdf FILE for 2d and 3d arrays 518 519 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 520 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 521 & 0, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 522 523 ! Vertical grid for 2d and 3d arrays 524 525 CALL histvert( nitd, 'deptht', 'Vertical T levels', & 526 & 'm', ipk, gdept_0, ndepitd) 527 528 ! Declare all the output fields as NETCDF variables 529 530 ! more 3D horizontal arrays 531 DO jn = 1, jpdia3d 532 cltra = ctrc3d(jn) ! short title for 3D diagnostic 533 cltral = ctrc3l(jn) ! long title for 3D diagnostic 534 cltrau = ctrc3u(jn) ! UNIT for 3D diagnostic 535 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 536 & ipk, 1, ipk, ndepitd, 32, clop, zsto, zout ) 537 END DO 538 539 ! more 2D horizontal arrays 540 DO jn = 1, jpdia2d 703 541 cltra=ctrc2d(jn) ! short title for 2D diagnostic 704 542 cltral=ctrc2l(jn) ! long title for 2D diagnostic 705 543 cltrau=ctrc2u(jn) ! UNIT for 2D diagnostic 706 CALL histdef(nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 707 & 1, 1, 1, -99, 32, clop, zsto, zout) 708 END DO 709 710 ! TODO: more 2D vertical sections arrays : I or J indice fixed 711 712 ! CLOSE netcdf Files 713 714 CALL histend(nitd) 544 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 545 & 1, 1, 1, -99, 32, clop, zsto, zout ) 546 END DO 547 548 ! TODO: more 2D vertical sections arrays : I or J indice fixed 549 550 ! CLOSE netcdf Files 551 CALL histend( nitd ) 715 552 716 553 IF(lwp) WRITE(numout,*) 717 554 IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdii_wr' 718 IF( ll_print)CALL FLUSH(numout )719 720 ENDIF 721 722 ! 2. Start writing data723 ! ---------------------724 725 IF( lwp .AND. MOD( kt, nwrite add) == 0 ) THEN555 IF( ll_print ) CALL FLUSH(numout ) 556 ! 557 ENDIF 558 559 ! 2. Start writing data 560 ! --------------------- 561 562 IF( lwp .AND. MOD( kt, nwritedia ) == 0 ) THEN 726 563 WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step' 727 564 WRITE(numout,*) '~~~~~~ ' 728 565 ENDIF 729 566 730 ! more 3D horizontal arrays 731 732 DO jn=1,jpdia3d 733 cltra=ctrc3d(jn) ! short title for 3D diagnostic 734 CALL histwrite(nitd, cltra, it, trc3d(:,:,:,jn), ndimt50 & 735 & ,ndext50) 736 END DO 737 738 ! more 2D horizontal arrays 739 740 DO jn=1,jpdia2d 741 cltra=ctrc2d(jn) ! short title for 2D diagnostic 742 CALL histwrite(nitd, cltra, it, trc2d(:,:,jn), ndimt51 & 567 ! more 3D horizontal arrays 568 DO jn = 1, jpdia3d 569 cltra = ctrc3d(jn) ! short title for 3D diagnostic 570 CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jn), ndimt50 & 571 & ,ndext50) 572 END DO 573 574 ! more 2D horizontal arrays 575 DO jn = 1, jpdia2d 576 cltra = ctrc2d(jn) ! short title for 2D diagnostic 577 CALL histwrite(nitd, cltra, it, trc2d(:,:,jn), ndimt51 & 743 578 & ,ndext51) 744 END DO 745 746 ! synchronise FILE 747 748 IF( MOD( kt, nwriteadd ) == 0 .OR. kindic < 0 ) THEN 749 CALL histsync(nitd) 750 ENDIF 751 752 ! 3. Closing all files 753 ! -------------------- 754 755 IF( kt == nitend .OR. kindic < 0 ) THEN 756 CALL histclo(nitd) 757 ENDIF 758 579 END DO 580 581 ! synchronise FILE 582 IF( MOD( kt, nwritedia ) == 0 .OR. kindic < 0 ) CALL histsync( nitd ) 583 584 ! Closing all files 585 ! ----------------- 586 IF( kt == nitend .OR. kindic < 0 ) CALL histclo(nitd) 587 ! 759 588 END SUBROUTINE trcdii_wr 760 589 761 # else 762 763 SUBROUTINE trcdii_wr(kt,kindic) 764 !!! no passive tracers 765 INTEGER, INTENT ( in ) :: kt, kindic 766 WRITE(*,*) 'trcdii_wr: You should not have seen this print! error?', kt, kindic 767 END SUBROUTINE trcdii_wr 768 769 # endif 770 771 # if defined key_passivetrc && defined key_trc_diabio 772 773 SUBROUTINE trcdib_wr(kt,kindic) 774 !!=========================================================================================== 775 !! 776 !! ROUTINE trcdib_wr 777 !!=========================================================================================== 778 !! 779 !! Purpose : 780 !!--------- 781 !! Specific output of opa: biological fields 782 !! 783 !! 784 !! Method : 785 !! ------- 786 !! 787 !! At the beginning of the first time step (nit000), define all 788 !! the NETCDF files and fields for biological fields 789 !! 790 !! At each time step call histdef to compute the mean if necessary 791 !! Each nwritetrd time step, output the instantaneous or mean fields 792 !! 793 !! IF kindic <0, output of fields before the model interruption. 794 !! IF kindic =0, time step loop 795 !! IF kindic >0, output of fields before the time step loop 796 !! 797 !! Input : 798 !! ----- 799 !! argument 800 !! kt : time step 801 !! kindic : indicator of abnormal termination 802 !! 803 !! Output : 804 !! ------ 805 !! file 806 !! "histname" files : at least one file for each grid 807 !! 808 !! History: 809 !! -------- 810 !! original : 95-01 passive tracers (M. Levy) 811 !! additions : 98-01 (C. Levy) NETCDF format using ioipsl interface 812 !! additions : 99-01 (M.A. Foujols) adapted for passive tracer 813 !! additions : 99-09 (M.A. Foujols) split into three parts 814 !! additions : 01-06 (E Kestenare) assign a parameter to name 815 !! individual tracers 816 !! additions : 05-03 (O. Aumont and A El Moussaoui) F90 817 !!==================================================================================================! 818 819 !! Modules used 820 USE ioipsl 590 # else 591 SUBROUTINE trcdii_wr( kt, kindic ) ! Dummy routine 592 INTEGER, INTENT ( in ) :: kt, kindic 593 WRITE(*,*) 'trcdii_wr: You should not have seen this print! error?', kt, kindic 594 END SUBROUTINE trcdii_wr 595 # endif 596 597 # if defined key_trc_diabio 598 599 SUBROUTINE trcdib_wr( kt, kindic ) 600 !!---------------------------------------------------------------------- 601 !! *** ROUTINE trcdib_wr *** 602 !! 603 !! ** Purpose : output of passive tracer : biological fields 604 !! 605 !! ** Method : At the beginning of the first time step (nit000), define all 606 !! the NETCDF files and fields for concentration of passive tracer 607 !! 608 !! At each time step call histdef to compute the mean if necessary 609 !! Each nwritetrc time step, output the instantaneous or mean fields 610 !! 611 !! IF kindic <0, output of fields before the model interruption. 612 !! IF kindic =0, time step loop 613 !! IF kindic >0, output of fields before the time step loop 614 !!---------------------------------------------------------------------- 821 615 USE sms 822 823 !! * Arguments 824 INTEGER, INTENT( in ) :: kt,kindic ! ocean time-step 825 826 INTEGER :: ji, jj, jk, jn 827 LOGICAL :: ll_print = .FALSE. 828 829 CHARACTER (len=40) :: clhstnam, clop 830 CHARACTER (len=20) :: cltra, cltrau 831 CHARACTER (len=80) :: cltral 832 833 REAL(wp) :: zsto, zout, zdt 834 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 835 836 ! 837 ! 0. Initialisation 838 ! ----------------- 839 840 ! local variable for debugging 616 !! 617 INTEGER, INTENT( in ) :: kt ! ocean time-step 618 INTEGER, INTENT( in ) :: kindic ! indicator of abnormal termination 619 !! 620 LOGICAL :: ll_print = .FALSE. 621 CHARACTER (len=40) :: clhstnam, clop 622 CHARACTER (len=20) :: cltra, cltrau 623 CHARACTER (len=80) :: cltral 624 INTEGER :: ji, jj, jk, jn 625 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 626 REAL(wp) :: zsto, zout, zdt 627 !!---------------------------------------------------------------------- 628 629 ! Initialisation 630 ! -------------- 631 632 ! local variable for debugging 841 633 ll_print = .FALSE. 842 634 ll_print = ll_print .AND. lwp 843 ! 844 ! Define frequency of output and means 845 ! 635 636 ! Define frequency of output and means 846 637 zdt = rdt 847 638 # if defined key_diainstant … … 862 653 it = kt - nittrc000 + 1 863 654 864 ! 1. Define NETCDF files and fields at beginning of first time step 865 ! ----------------------------------------------------------------- 866 867 IF(ll_print)WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 868 IF(kt == nittrc000) THEN 869 870 ! Define the NETCDF files for biological trends 871 872 CALL dia_nam(clhstnam,nwrite,'biolog') 873 IF(lwp)WRITE(numout,*) & 874 & " Name of NETCDF file for biological trends ",clhstnam 875 ! Horizontal grid : glamt and gphit 876 CALL histbeg(clhstnam, jpi, glamt, jpj, gphit, & 877 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 878 & 0, zjulian, rdt, nhoritb, nitb , domain_id=nidom) 879 ! Vertical grid for biological trends 880 CALL histvert(nitb, 'deptht', 'Vertical T levels', & 881 & 'm', ipk, gdept_0, ndepitb) 882 883 ! Declare all the output fields as NETCDF variables 884 885 ! biological trends 886 887 DO jn=1,jpdiabio 888 cltra=ctrbio(jn) ! short title for biological diagnostic 889 cltral=ctrbil(jn) ! long title for biological diagnostic 890 cltrau=ctrbiu(jn) ! UNIT for biological diagnostic 655 ! Define NETCDF files and fields at beginning of first time step 656 ! -------------------------------------------------------------- 657 658 IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 659 660 IF( kt == nittrc000 ) THEN 661 662 ! Define the NETCDF files for biological trends 663 664 CALL dia_nam(clhstnam,nwrite,'biolog') 665 IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam 666 ! Horizontal grid : glamt and gphit 667 CALL histbeg(clhstnam, jpi, glamt, jpj, gphit, & 668 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 669 & 0, zjulian, rdt, nhoritb, nitb , domain_id=nidom) 670 ! Vertical grid for biological trends 671 CALL histvert(nitb, 'deptht', 'Vertical T levels', & 672 & 'm', ipk, gdept_0, ndepitb) 673 674 ! Declare all the output fields as NETCDF variables 675 ! biological trends 676 DO jn = 1, jpdiabio 677 cltra = ctrbio(jn) ! short title for biological diagnostic 678 cltral = ctrbil(jn) ! long title for biological diagnostic 679 cltrau = ctrbiu(jn) ! UNIT for biological diagnostic 891 680 CALL histdef(nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb, & 892 & ipk, 1, ipk, ndepitb, 32, clop, zsto, zout) 893 END DO 894 895 ! CLOSE netcdf Files 896 681 & ipk, 1, ipk, ndepitb, 32, clop, zsto, zout) 682 END DO 683 684 ! CLOSE netcdf Files 897 685 CALL histend(nitb) 898 686 … … 900 688 IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization in trcdib_wr' 901 689 IF(ll_print) CALL FLUSH(numout ) 902 903 ENDIF 904 905 ! 2. Start writing data 906 ! --------------------- 907 908 ! biological trends 909 690 ! 691 ENDIF 692 693 ! Start writing data 694 ! ------------------ 695 696 ! biological trends 910 697 IF( lwp .AND. MOD( kt, nwritebio ) == 0 ) THEN 911 698 WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step' … … 913 700 ENDIF 914 701 915 916 DO jn=1,jpdiabio 702 DO jn = 1, jpdiabio 917 703 cltra=ctrbio(jn) ! short title for biological diagnostic 918 704 CALL histwrite(nitb, cltra, it, trbio(:,:,:,jn), ndimt50,ndext50) 919 705 END DO 920 706 921 ! synchronise FILE 922 923 IF( MOD( kt, nwritebio ) == 0 .OR. kindic < 0 ) THEN 924 CALL histsync(nitb) 925 ENDIF 926 927 ! 3. Closing all files 928 ! -------------------- 929 IF( kt == nitend .OR. kindic < 0 ) THEN 930 CALL histclo(nitb) 931 ENDIF 932 933 END SUBROUTINE trcdib_wr 934 935 # else 936 937 SUBROUTINE trcdib_wr(kt,kindic) 938 !!! no passive tracers 939 INTEGER, INTENT ( in ) :: kt, kindic 940 WRITE(*,*) 'trcdib_wr: You should not have seen this print! error?', kt, kindic 941 END SUBROUTINE trcdib_wr 942 943 # endif 944 707 ! synchronise FILE 708 IF( MOD( kt, nwritebio ) == 0 .OR. kindic < 0 ) CALL histsync( nitb ) 709 710 ! Closing all files 711 ! ----------------- 712 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nitb ) 713 ! 714 END SUBROUTINE trcdib_wr 715 716 # else 717 SUBROUTINE trcdib_wr( kt, kindic ) ! Dummy routine 718 INTEGER, INTENT ( in ) :: kt, kindic 719 WRITE(*,*) 'trcdib_wr: You should not have seen this print! error?', kt, kindic 720 END SUBROUTINE trcdib_wr 721 # endif 722 723 #else 724 !!---------------------------------------------------------------------- 725 !! Dummy module : No passive tracer 726 !!---------------------------------------------------------------------- 727 CONTAINS 728 SUBROUTINE trcdit_wr( kt, kindic ) ! Dummy routine 729 INTEGER, INTENT ( in ) :: kt, kindic 730 WRITE(*,*) 'trcdit_wr: You should not have seen this print! error?', kt, kindic 731 END SUBROUTINE trcdit_wr 732 SUBROUTINE trcdid_wr( kt, kindic ) ! Dummy routine 733 INTEGER, INTENT ( in ) :: kt, kindic 734 WRITE(*,*) 'trcdid_wr: You should not have seen this print! error?', kt, kindic 735 END SUBROUTINE trcdid_wr 736 SUBROUTINE trcdii_wr( kt, kindic ) ! Dummy routine 737 INTEGER, INTENT ( in ) :: kt, kindic 738 WRITE(*,*) 'trcdii_wr: You should not have seen this print! error?', kt, kindic 739 END SUBROUTINE trcdii_wr 740 SUBROUTINE trcdib_wr( kt, kindic ) ! Dummy routine 741 INTEGER, INTENT ( in ) :: kt, kindic 742 WRITE(*,*) 'trcdib_wr: You should not have seen this print! error?', kt, kindic 743 END SUBROUTINE trcdib_wr 744 #endif 745 746 !!====================================================================== 945 747 END MODULE trcdit -
trunk/NEMO/TOP_SRC/trcdta.F90
r719 r945 2 2 !!====================================================================== 3 3 !! *** MODULE trcdta *** 4 !! Ocean data: reads passive tracer data4 !! TOP : reads passive tracer data 5 5 !!===================================================================== 6 !! TOP 1.0, LOCEAN-IPSL (2005) 7 !! $Header$ 8 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 9 !!---------------------------------------------------------------------- 10 11 #if defined key_passivetrc && defined key_dtatrc 12 !!---------------------------------------------------------------------- 13 !! 'key_dtatrc' 3D tracer data field 6 !! History : 1.0 ! 2002-04 (O. Aumont) original code 7 !! - ! 2004-03 (C. Ethe) module 8 !! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90 9 !!---------------------------------------------------------------------- 10 #if defined key_top && defined key_dtatrc 11 !!---------------------------------------------------------------------- 12 !! 'key_top' and 'key_dtatrc' TOP model + passive tracer data 14 13 !!---------------------------------------------------------------------- 15 14 !! dta_trc : read ocean passive tracer data 16 15 !!---------------------------------------------------------------------- 17 !! * Modules used18 16 USE oce_trc 17 USE par_trc 19 18 USE trc 20 USE par_sms21 19 USE lib_print 20 USE iom 22 21 23 22 IMPLICIT NONE 24 23 PRIVATE 25 24 26 !! * Routine accessibility 27 PUBLIC dta_trc ! called by trcdtr.F90 and trcdmp.F90 28 29 !! * Shared module variables 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) :: & !: 31 trdta !: tracer data at given time-step 32 33 !! * Module variables 34 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) :: & 35 tracdta ! tracer data at two consecutive times 36 INTEGER , DIMENSION(jptra) :: & 37 nlectr , & !!: switch for reading once 38 ntrc1 , & !!: number of first month when reading 12 monthly value 39 ntrc2 !!: number of second month when reading 12 monthly value 25 PUBLIC dta_trc ! called in trcdtr.F90 and trcdmp.F90 26 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) :: trdta !: tracer data at given time-step 28 29 REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,2) :: tracdta ! tracer data at two consecutive times 30 INTEGER , DIMENSION(jptra) :: nlectr !: switch for reading once 31 INTEGER , DIMENSION(jptra) :: ntrc1 !: number of first month when reading 12 monthly value 32 INTEGER , DIMENSION(jptra) :: ntrc2 !: number of second month when reading 12 monthly value 40 33 41 34 !! * Substitutions 42 # include "passivetrc_substitute.h90" 43 44 !!---------------------------------------------------------------------- 45 !! OPA 9.0 , LODYC-IPSL (2003) 35 # include "top_substitute.h90" 36 !!---------------------------------------------------------------------- 37 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 38 !! $Header:$ 39 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 46 40 !!---------------------------------------------------------------------- 47 41 … … 64 58 !! At each time step, a linear interpolation is applied between 65 59 !! two monthly values. 60 !!---------------------------------------------------------------------- 61 INTEGER, INTENT( in ) :: kt ! ocean time-step 66 62 !! 67 !! History : 68 !! 8.2 ! 02-04 (O. Aumont) Original code 69 !! 9.0 ! 04-03 (C. Ethe) 70 !! 9.0 ! 05-03 (O. Aumont and A. El Moussaoui) F90 71 !!---------------------------------------------------------------------- 72 !! * Modules used 73 USE iom 74 75 !! * Arguments 76 INTEGER, INTENT( in ) :: kt ! ocean time-step 77 78 !! * Local declarations 79 INTEGER :: ji, jj, jn, jl 80 INTEGER, PARAMETER :: & 81 jpmois = 12 ! number of months 82 83 INTEGER :: & 84 imois, iman, i15, ik ! temporary integers 85 CHARACTER (len=39) :: clname(jptra) 86 REAL(wp) :: zxy, zl 63 CHARACTER (len=39) :: clname(jptra) 64 INTEGER, PARAMETER :: jpmois = 12 ! number of months 65 INTEGER :: ji, jj, jn, jl 66 INTEGER :: imois, iman, i15, ik ! temporary integers 67 REAL(wp) :: zxy, zl 87 68 !!---------------------------------------------------------------------- 88 69 … … 113 94 IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' 114 95 ! open file 115 # if defined key_trc_pisces96 # if defined key_pisces 116 97 clname(jn) = 'LEVITUS_'//ctrcnm(jn) 117 # else98 # else 118 99 clname(jn) = ctrcnm(jn) 119 # endif100 # endif 120 101 CALL iom_open ( clname(jn), numtr(jn) ) 121 102 122 103 ENDIF 123 104 124 # if defined key_trc_pisces105 # if defined key_pisces 125 106 ! Read montly file 126 107 IF( ( kt == nittrc000 .AND. nlectr(jn) == 0) .OR. imois /= ntrc1(jn) ) THEN … … 161 142 ik = mbathy(ji,jj) - 1 162 143 IF( ik > 2 ) THEN 163 zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 164 tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik,jn,jl) + zl * tracdta(ji,jj,ik-1,jn,jl) 144 zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 145 tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik ,jn,jl) & 146 & + zl * tracdta(ji,jj,ik-1,jn,jl) 165 147 ENDIF 166 148 END DO … … 173 155 174 156 IF(lwp) THEN 175 WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), & 176 ntrc2(jn) 157 WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), ntrc2(jn) 177 158 WRITE(numout,*) 178 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), & 179 ' level = 1' 159 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), ' level = 1' 180 160 CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1 & 181 ,jpj, 20, 1., numout ) 182 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), & 183 ' level = ',jpk/2 161 & ,jpj, 20, 1., numout ) 162 WRITE(numout,*) ' Levitus month = ', ntrc1(jn), ' level = ',jpk/2 184 163 CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi, & 185 20, 1, jpj, 20, 1., numout ) 186 WRITE(numout,*) ' Levitus month = ',ntrc1(jn) & 187 ,' level = ',jpkm1 164 & 20, 1, jpj, 20, 1., numout ) 165 WRITE(numout,*) ' Levitus month = ',ntrc1(jn),' level = ',jpkm1 188 166 CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi, & 189 20, 1, jpj, 20, 1., numout )167 & 20, 1, jpj, 20, 1., numout ) 190 168 ENDIF 191 169 192 170 ! At every time step compute temperature data 193 194 171 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 195 trdta(:,:,:,jn) = ( 1. - zxy ) * tracdta(:,:,:,jn,1) &196 + zxy * tracdta(:,:,:,jn,2)197 198 IF( jn == jpno3 ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6E-6199 IF( jn == jpdic ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6200 IF( jn == jptal ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6201 IF( jn == jpoxy ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6E-6202 IF( jn == jpsil ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.E-6203 IF( jn == jppo4 ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.E-6172 trdta(:,:,:,jn) = ( 1. - zxy ) * tracdta(:,:,:,jn,1) & 173 & + zxy * tracdta(:,:,:,jn,2) 174 175 IF( jn == jpno3 ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 7.6e-6 176 IF( jn == jpdic ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.0e-6 177 IF( jn == jptal ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.0e-6 178 IF( jn == jpoxy ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 44.6e-6 179 IF( jn == jpsil ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 1.0e-6 180 IF( jn == jppo4 ) trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.0e-6 204 181 205 182 ! Close the file 206 183 ! -------------- 207 184 208 IF( kt == nitend ) CALL iom_close 209 210 # else185 IF( kt == nitend ) CALL iom_close( numtr(jn) ) 186 187 # else 211 188 ! Read init file only 212 189 IF( kt == nittrc000 ) THEN … … 215 192 CALL iom_close ( numtr(jn) ) 216 193 ENDIF 217 # endif218 219 ENDIF220 221 222 194 # endif 195 196 ENDIF 197 198 END DO 199 ! 223 200 END SUBROUTINE dta_trc 224 201 225 202 #else 226 227 !!---------------------------------------------------------------------- 228 !! Default case NO 3D passive tracer data field 203 !!---------------------------------------------------------------------- 204 !! Dummy module NO 3D passive tracer data 229 205 !!---------------------------------------------------------------------- 230 206 CONTAINS … … 232 208 WRITE(*,*) 'dta_trc: You should not have seen this print! error?', kt 233 209 END SUBROUTINE dta_trc 234 235 210 #endif 236 211 212 !!====================================================================== 237 213 END MODULE trcdta -
trunk/NEMO/TOP_SRC/trcdtr.F90
r730 r945 1 1 MODULE trcdtr 2 !!======================================================================================= 3 !! 4 !! *** MODULE trcdtr *** 5 !! 6 !! Computes or READ initial DATA for passive tracer 7 !! 8 !!======================================================================================= 9 !! TOP 1.0, LOCEAN-IPSL (2005) 10 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcdtr.F90,v 1.8 2007/10/17 14:48:56 opalod Exp $ 11 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 12 !!---------------------------------------------------------------------- 13 !!---------------------------------------------------------------------- 14 !! * Modules used 15 !! ============== 16 USE oce_trc 17 USE trc 18 USE sms 19 USE trcdta 20 USE lib_mpp 21 22 IMPLICIT NONE 23 PRIVATE 24 !! * Accessibility 25 PUBLIC trc_dtr 2 !!====================================================================== 3 !! *** MODULE trcdtr *** 4 !! TOP : computes or READ initial DATA for passive tracer 5 !!====================================================================== 6 !! History : - ! 1996-11 () original code 7 !! ! 2000-12 (O. Aumont, E. Kestenare) add for POC in sediments 8 !! 1.0 ! 2005-12 (O. Aumont, A. El Moussaoui) F90 9 !!---------------------------------------------------------------------- 10 #if defined key_top 11 !!---------------------------------------------------------------------- 12 !! 'key_top' TOP models 13 !!---------------------------------------------------------------------- 14 !! trc_dtr : computes or READ initial DATA for passive tracer 15 !!---------------------------------------------------------------------- 16 USE oce_trc 17 USE trc 18 USE sms 19 USE trcdta 20 USE lib_mpp 21 22 IMPLICIT NONE 23 PRIVATE 24 25 PUBLIC trc_dtr ! called in ??? 26 27 !!---------------------------------------------------------------------- 28 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 29 !! $Header:$ 30 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 31 !!---------------------------------------------------------------------- 26 32 27 33 CONTAINS 28 34 29 #if defined key_passivetrc 30 31 SUBROUTINE trc_dtr 32 !!--------------------------------------------------------------------- 33 !! 34 !! ROUTINE trci_dtr 35 !! ****************** 36 !! PURPOSE : 37 !! --------- 38 !! computes or READ initial DATA for passive tracer 39 !! ----- 40 !! COMMON 41 !! /comdom/ : domain PARAMETER 42 !! /comcoo/ : orthogonal curvilinear coordinates 43 !! and scale factors 44 !! /comask/ : masks, bathymetry 45 !! OUTPUT : 46 !! ------ 47 !! COMMON 48 !! /cottrc/ : passive tracer field now and before 49 !! 50 !! 51 !! History: 52 !! -------- 53 !! original : 96-11 54 !! additions : 99-9 55 !! : 00-12 (O. Aumont, E. Kestenare) add for POC in sediments 56 !! add for POC in sediments 57 !! 03/05 O. Aumont and A. El Moussaoui F90 58 !!---------------------------------------------------------------------- 59 !!---------------------------------------------------------------------- 60 !! local declarations 61 !! ================== 62 INTEGER :: ji,jj,jk,jn 63 #if defined key_trc_pisces 64 REAL(wp) :: alka0,oxyg0,calc0,bioma0, & 65 silic1,po4,no3,caralk,bicarb,co3 66 #endif 67 !!--------------------------------------------------------------------- 68 !! OPA.9 69 !!--------------------------------------------------------------------- 70 !! 0. initialisations 71 !! ------------------ 72 73 IF(lwp) WRITE(numout,*) ' ' 74 IF(lwp) WRITE(numout,*) ' *** trcdtr initialisation for ' 75 IF(lwp) WRITE(numout,*) ' passive tracers' 76 IF(lwp) WRITE(numout,*) ' ' 77 35 SUBROUTINE trc_dtr 36 !!--------------------------------------------------------------------- 37 !! *** ROUTINE trc_dtr *** 38 !! 39 !! ** Purpose : computes or READ initial DATA for passive tracer 40 !! 41 !! ** Method : 42 !!--------------------------------------------------------------------- 43 INTEGER :: ji, jj, jk, jn 44 # if defined key_pisces 45 REAL(wp) :: alka0, sco2, oxyg0, calc0, bioma0 46 REAL(wp) :: silic1, po4, no3, caralk, bicarb, co3 47 # endif 48 !!--------------------------------------------------------------------- 49 50 IF(lwp) WRITE(numout,*) 51 IF(lwp) WRITE(numout,*) 'trc_dtr : initialisation of the passive tracers' 52 IF(lwp) WRITE(numout,*) '~~~~~~~' 78 53 79 54 #if defined key_cfc 80 trn(:,:,:,:)=0.0 81 #elif defined key_trc_pisces 82 83 sco2 = 2.3e-3 84 alka0 = 2.39e-3 85 oxyg0 = 1.8e-4 86 po4 = 2.165e-6/po4r 87 bioma0 = 1.e-8 88 silic1 = 91.51e-6 89 calc0 = 1.e-6 90 no3 = 30.88E-6*7.6 55 trn(:,:,:,:) = 0.0 ! CFC initialisation to zero 56 57 #elif defined key_pisces 58 ! PISCES initialisation 59 ! --------------------- 60 sco2 = 2.312e-3 61 alka0 = 2.423e-3 62 oxyg0 = 177.6e-6 63 po4 = 2.174e-6 / po4r 64 bioma0 = 1.000e-8 65 silic1 = 91.65e-6 66 no3 = 31.04e-6 * 7.6 91 67 92 68 trn(:,:,:,jpdic) = sco2 … … 94 70 trn(:,:,:,jptal) = alka0 95 71 trn(:,:,:,jpoxy) = oxyg0 96 trn(:,:,:,jpcal) = calc072 trn(:,:,:,jpcal) = bioma0 97 73 trn(:,:,:,jppo4) = po4 98 74 trn(:,:,:,jppoc) = bioma0 99 # if ! defined key_trc_kriest75 # if ! defined key_kriest 100 76 trn(:,:,:,jpgoc) = bioma0 101 trn(:,:,:,jpbfe) = bioma0 *5E-6102 # else103 trn(:,:,:,jpnum) = bioma0 /(6.*xkr_massp)104 # endif77 trn(:,:,:,jpbfe) = bioma0 * 5.e-6 78 # else 79 trn(:,:,:,jpnum) = bioma0 / ( 6. * xkr_massp ) 80 # endif 105 81 trn(:,:,:,jpsil) = silic1 106 trn(:,:,:,jpbsi) = bioma0 *0.15107 trn(:,:,:,jpdsi) = bioma0 *5.E-682 trn(:,:,:,jpbsi) = bioma0 * 0.15 83 trn(:,:,:,jpdsi) = bioma0 * 5.e-6 108 84 trn(:,:,:,jpphy) = bioma0 109 85 trn(:,:,:,jpdia) = bioma0 … … 111 87 trn(:,:,:,jpmes) = bioma0 112 88 trn(:,:,:,jpfer) = 0.6E-9 113 trn(:,:,:,jpsfe) = bioma0 *5.E-6114 trn(:,:,:,jpdfe) = bioma0 *5.E-6115 trn(:,:,:,jpnfe) = bioma0 *5.E-6116 trn(:,:,:,jpnch) = bioma0 *12./55.117 trn(:,:,:,jpdch) = bioma0 *12./55.89 trn(:,:,:,jpsfe) = bioma0 * 5.e-6 90 trn(:,:,:,jpdfe) = bioma0 * 5.e-6 91 trn(:,:,:,jpnfe) = bioma0 * 5.e-6 92 trn(:,:,:,jpnch) = bioma0 * 12. / 55. 93 trn(:,:,:,jpdch) = bioma0 * 12. / 55. 118 94 trn(:,:,:,jpno3) = no3 119 95 trn(:,:,:,jpnh4) = bioma0 120 96 121 122 !! Initialization of chemical variables of the carbon cycle 123 !! -------------------------------------------------------- 124 125 DO jk = 1,jpk 126 DO jj = 1,jpj 127 DO ji = 1,jpi 128 caralk = trn(ji,jj,jk,jptal)- & 129 borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk))) 130 co3 = (caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk) & 131 & +(1.-tmask(ji,jj,jk))*.5e-3 132 bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk) 133 hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3) & 134 *tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9 135 ENDDO 136 ENDDO 137 ENDDO 138 139 140 !! initialize the half saturation constant for silicate 141 !! ---------------------------------------------------- 142 143 xksi(:,:)=2.E-6 97 ! Initialization of chemical variables of the carbon cycle 98 ! -------------------------------------------------------- 99 DO jk = 1, jpk 100 DO jj = 1, jpj 101 DO ji = 1, jpi 102 caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 103 co3 = ( caralk - trn(ji,jj,jk,jpdic) ) * tmask(ji,jj,jk) & 104 & + 0.5e-3 * ( 1. - tmask(ji,jj,jk) ) 105 bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk) 106 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 ) * tmask(ji,jj,jk) & 107 & + 1.e-9 * ( 1. - tmask(ji,jj,jk) ) 108 END DO 109 END DO 110 END DO 111 112 ! initialize the half saturation constant for silicate 113 ! ---------------------------------------------------- 114 xksi(:,:) = 2.e-6 144 115 145 116 IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 146 117 IF(lwp) WRITE(numout,*) ' ' 147 118 148 #elif defined key_trc_lobster1 && ( defined key_eel_r6 || defined key_eel_r2 ) 149 ! analytical initialisation used in Levy et al. (2001) 119 # elif defined key_lobster && ( defined key_eel_r6 || defined key_eel_r2 ) 120 ! LOBSTER initialisation for EEL 121 ! ---------------------- 122 ! here: analytical initialisation used in Levy et al. (2001) 150 123 151 DO jk =1,7152 trn(:,:,jk,jpdet)=0.016*tmask(:,:,jk)153 trn(:,:,jk,jpzoo)=0.018*tmask(:,:,jk)154 trn(:,:,jk,jpphy)=0.036*tmask(:,:,jk)155 trn(:,:,jk,jpno3)=1.e-5*tmask(:,:,jk)156 trn(:,:,jk,jpnh4)=0.0005*tmask(:,:,jk)157 trn(:,:,jk,jpdom)=0.017*tmask(:,:,jk)158 END DO 159 160 trn(:,:, 8,jpdet)=0.020*tmask(:,:,1)161 trn(:,:, 8,jpzoo)=0.027*tmask(:,:,1)162 trn(:,:, 8,jpphy)=0.041*tmask(:,:,1)163 trn(:,:, 8,jpno3)=0.00022*tmask(:,:,1)164 trn(:,:, 8,jpnh4)=0.0033*tmask(:,:,1)165 trn(:,:, 8,jpdom)=0.021*tmask(:,:,1)166 167 trn(:,:, 9,jpdet)=0.0556*tmask(:,:,1)168 trn(:,:, 9,jpzoo)=0.123*tmask(:,:,1)169 trn(:,:, 9,jpphy)=0.122*tmask(:,:,1)170 trn(:,:, 9,jpno3)=0.028*tmask(:,:,1)171 trn(:,:, 9,jpnh4)=0.024*tmask(:,:,1)172 trn(:,:, 9,jpdom)=0.06*tmask(:,:,1)173 174 trn(:,:,10,jpdet) =0.025*tmask(:,:,1)175 trn(:,:,10,jpzoo) =0.016*tmask(:,:,1)176 trn(:,:,10,jpphy) =0.029*tmask(:,:,1)177 trn(:,:,10,jpno3) =2.462*tmask(:,:,1)178 trn(:,:,10,jpnh4) =0.04*tmask(:,:,1)179 trn(:,:,10,jpdom) =0.022*tmask(:,:,1)180 181 trn(:,:,11,jpdet) =0.0057*tmask(:,:,1)182 trn(:,:,11,jpzoo) =0.0005*tmask(:,:,1)183 trn(:,:,11,jpphy) =0.0006*tmask(:,:,1)184 trn(:,:,11,jpno3) =3.336*tmask(:,:,1)185 trn(:,:,11,jpnh4) =0.005*tmask(:,:,1)186 trn(:,:,11,jpdom) =0.004*tmask(:,:,1)187 188 trn(:,:,12,jpdet) =0.002*tmask(:,:,1)189 trn(:,:,12,jpzoo) =1.e-6*tmask(:,:,1)190 trn(:,:,12,jpphy) =5.e-6*tmask(:,:,1)191 trn(:,:,12,jpno3) =4.24*tmask(:,:,1)192 trn(:,:,12,jpnh4) =0.001*tmask(:,:,1)193 trn(:,:,12,jpdom) =3.e-5*tmask(:,:,1)124 DO jk = 1, 7 125 trn(:,:,jk,jpdet) = 0.016 * tmask(:,:,jk) 126 trn(:,:,jk,jpzoo) = 0.018 * tmask(:,:,jk) 127 trn(:,:,jk,jpphy) = 0.036 * tmask(:,:,jk) 128 trn(:,:,jk,jpno3) = 1.e-5 * tmask(:,:,jk) 129 trn(:,:,jk,jpnh4) = 5.e-4 * tmask(:,:,jk) 130 trn(:,:,jk,jpdom) = 0.017 * tmask(:,:,jk) 131 END DO 132 133 trn(:,:, 8,jpdet) = 0.020 * tmask(:,:, 8) 134 trn(:,:, 8,jpzoo) = 0.027 * tmask(:,:, 8) 135 trn(:,:, 8,jpphy) = 0.041 * tmask(:,:, 8) 136 trn(:,:, 8,jpno3) = 0.00022 * tmask(:,:, 8) 137 trn(:,:, 8,jpnh4) = 0.0033 * tmask(:,:, 8) 138 trn(:,:, 8,jpdom) = 0.021 * tmask(:,:, 8) 139 140 trn(:,:, 9,jpdet) = 0.0556 * tmask(:,:, 9) 141 trn(:,:, 9,jpzoo) = 0.123 * tmask(:,:, 9) 142 trn(:,:, 9,jpphy) = 0.122 * tmask(:,:, 9) 143 trn(:,:, 9,jpno3) = 0.028 * tmask(:,:, 9) 144 trn(:,:, 9,jpnh4) = 0.024 * tmask(:,:, 9) 145 trn(:,:, 9,jpdom) = 0.06 * tmask(:,:, 9) 146 147 trn(:,:,10,jpdet) = 0.025 * tmask(:,:,10) 148 trn(:,:,10,jpzoo) = 0.016 * tmask(:,:,10) 149 trn(:,:,10,jpphy) = 0.029 * tmask(:,:,10) 150 trn(:,:,10,jpno3) = 2.462 * tmask(:,:,10) 151 trn(:,:,10,jpnh4) = 0.04 * tmask(:,:,10) 152 trn(:,:,10,jpdom) = 0.022 * tmask(:,:,10) 153 154 trn(:,:,11,jpdet) = 0.0057 * tmask(:,:,11) 155 trn(:,:,11,jpzoo) = 0.0005 * tmask(:,:,11) 156 trn(:,:,11,jpphy) = 0.0006 * tmask(:,:,11) 157 trn(:,:,11,jpno3) = 3.336 * tmask(:,:,11) 158 trn(:,:,11,jpnh4) = 0.005 * tmask(:,:,11) 159 trn(:,:,11,jpdom) = 0.004 * tmask(:,:,11) 160 161 trn(:,:,12,jpdet) = 0.002 * tmask(:,:,12) 162 trn(:,:,12,jpzoo) = 1.e-6 * tmask(:,:,12) 163 trn(:,:,12,jpphy) = 5.e-6 * tmask(:,:,12) 164 trn(:,:,12,jpno3) = 4.24 * tmask(:,:,12) 165 trn(:,:,12,jpnh4) = 0.001 * tmask(:,:,12) 166 trn(:,:,12,jpdom) = 3.e-5 * tmask(:,:,12) 194 167 195 168 DO jk=13,jpk 196 trn(:,:,jk,jpdet)=0.0 197 trn(:,:,jk,jpzoo)=0.0 198 trn(:,:,jk,jpphy)=0.0 199 trn(:,:,jk,jpnh4)=0.0 200 trn(:,:,jk,jpdom)=0.0 201 END DO 202 203 trn(:,:,13,jpno3)=5.31*tmask(:,:,13) 204 trn(:,:,14,jpno3)=6.73*tmask(:,:,14) 205 trn(:,:,15,jpno3)=8.32*tmask(:,:,15) 206 trn(:,:,16,jpno3)=10.13*tmask(:,:,16) 207 trn(:,:,17,jpno3)=11.95*tmask(:,:,17) 208 trn(:,:,18,jpno3)=13.57*tmask(:,:,18) 209 trn(:,:,19,jpno3)=15.08*tmask(:,:,19) 210 trn(:,:,20,jpno3)=16.41*tmask(:,:,20) 211 trn(:,:,21,jpno3)=17.47*tmask(:,:,21) 212 trn(:,:,22,jpno3)=18.29*tmask(:,:,22) 213 trn(:,:,23,jpno3)=18.88*tmask(:,:,23) 214 trn(:,:,24,jpno3)=19.30*tmask(:,:,24) 215 trn(:,:,25,jpno3)=19.68*tmask(:,:,25) 216 trn(:,:,26,jpno3)=19.91*tmask(:,:,26) 217 trn(:,:,27,jpno3)=19.99*tmask(:,:,27) 218 trn(:,:,28,jpno3)=20.01*tmask(:,:,28) 219 trn(:,:,29,jpno3)=20.01*tmask(:,:,29) 220 trn(:,:,30,jpno3)=20.01*tmask(:,:,30) 221 222 #elif defined key_trc_lobster1 && defined key_gyre 223 ! init NO3=f(density) by asklod AS Kremeur 2005-07 224 trn(:,:,:,jpdet)=0.1*tmask(:,:,:) 225 trn(:,:,:,jpzoo)=0.1*tmask(:,:,:) 226 trn(:,:,:,jpnh4)=0.1*tmask(:,:,:) 227 trn(:,:,:,jpphy)=0.1*tmask(:,:,:) 228 trn(:,:,:,jpdom)=1.*tmask(:,:,:) 229 DO jk=1,jpk 230 DO jj=1,jpj 231 DO ji=1,jpi 232 IF (rhd(ji,jj,jk).LE.24.5e-3) THEN 233 trn(ji,jj,jk,jpno3)=2.*tmask(ji,jj,jk) 169 trn(:,:,jk,jpdet) = 0.e0 170 trn(:,:,jk,jpzoo) = 0.e0 171 trn(:,:,jk,jpphy) = 0.e0 172 trn(:,:,jk,jpnh4) = 0.e0 173 trn(:,:,jk,jpdom) = 0.e0 174 END DO 175 176 trn(:,:,13,jpno3) = 5.31 * tmask(:,:,13) 177 trn(:,:,14,jpno3) = 6.73 * tmask(:,:,14) 178 trn(:,:,15,jpno3) = 8.32 * tmask(:,:,15) 179 trn(:,:,16,jpno3) = 10.13 * tmask(:,:,16) 180 trn(:,:,17,jpno3) = 11.95 * tmask(:,:,17) 181 trn(:,:,18,jpno3) = 13.57 * tmask(:,:,18) 182 trn(:,:,19,jpno3) = 15.08 * tmask(:,:,19) 183 trn(:,:,20,jpno3) = 16.41 * tmask(:,:,20) 184 trn(:,:,21,jpno3) = 17.47 * tmask(:,:,21) 185 trn(:,:,22,jpno3) = 18.29 * tmask(:,:,22) 186 trn(:,:,23,jpno3) = 18.88 * tmask(:,:,23) 187 trn(:,:,24,jpno3) = 19.30 * tmask(:,:,24) 188 trn(:,:,25,jpno3) = 19.68 * tmask(:,:,25) 189 trn(:,:,26,jpno3) = 19.91 * tmask(:,:,26) 190 trn(:,:,27,jpno3) = 19.99 * tmask(:,:,27) 191 trn(:,:,28,jpno3) = 20.01 * tmask(:,:,28) 192 trn(:,:,29,jpno3) = 20.01 * tmask(:,:,29) 193 trn(:,:,30,jpno3) = 20.01 * tmask(:,:,30) 194 195 # elif defined key_lobster && defined key_gyre 196 ! LOBSTER initialisation for GYRE 197 ! ---------------------- 198 ! here: init NO3=f(density) by asklod AS Kremeur 2005-07 199 trn(:,:,:,jpdet) = 0.1 * tmask(:,:,:) 200 trn(:,:,:,jpzoo) = 0.1 * tmask(:,:,:) 201 trn(:,:,:,jpnh4) = 0.1 * tmask(:,:,:) 202 trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 203 trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 204 DO jk = 1, jpk 205 DO jj = 1, jpj 206 DO ji = 1, jpi 207 IF( rhd(ji,jj,jk) <= 24.5e-3 ) THEN 208 trn(ji,jj,jk,jpno3) = 2. * tmask(ji,jj,jk) 234 209 ELSE 235 trn(ji,jj,jk,jpno3) =(15.55*(rhd(ji,jj,jk)*1000)-380.11)*tmask(ji,jj,jk)210 trn(ji,jj,jk,jpno3) = ( 15.55 * ( rhd(ji,jj,jk) * 1000. ) - 380.11 ) * tmask(ji,jj,jk) 236 211 ENDIF 237 212 END DO … … 239 214 END DO 240 215 216 # else 217 ! Default case 218 ! ------------ 219 DO jn = 1, jptra 220 trn(:,:,:,jn) = 0.1 * tmask(:,:,:) 221 END DO 222 223 # endif 224 225 # if defined key_dtatrc 226 ! Initialization of tracer from a file that may also be used for damping 227 CALL dta_trc( nittrc000 ) 228 DO jn = 1, jptra 229 IF( lutini(jn) ) trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) ! initialisation from file if required 230 END DO 231 # endif 232 233 ! before field : 234 ! ------------- 235 trb(:,:,:,:) = trn(:,:,:,:) 236 237 # if defined key_lobster 238 ! initialize the POC in sediments 239 sedpocb(:,:) = 0.e0 240 sedpocn(:,:) = 0.e0 241 sedpoca(:,:) = 0.e0 242 # endif 243 ! 244 END SUBROUTINE trc_dtr 245 241 246 #else 242 243 !! general case 244 do jn = 1, jptra245 trn(:,:,:,jn)=0.1*tmask(:,:,:) 246 enddo247 247 !!---------------------------------------------------------------------- 248 !! Dummy module : No passive tracer 249 !!---------------------------------------------------------------------- 250 CONTAINS 251 SUBROUTINE trc_dtr ! Empty routine 252 END SUBROUTINE trc_dtr 248 253 #endif 249 254 250 #if defined key_dtatrc 251 !! Initialization of tracer from a file 252 !! that may also be used for damping 253 CALL dta_trc( nittrc000 ) 254 DO jk = 1, jptra 255 IF( lutini(jk) ) THEN 256 !! initialisation from file 257 trn(:,:,:,jk) = trdta(:,:,:,jk)*tmask(:,:,:) 258 ENDIF 259 END DO 260 #endif 261 262 !! before field : 263 !! ------------- 264 trb(:,:,:,:) = trn(:,:,:,:) 265 266 #if defined key_trc_lobster1 267 !! initialize the POC in sediments 268 269 sedpocb(:,:) = 0. 270 sedpocn(:,:) = 0. 271 sedpoca(:,:) = 0. 272 #endif 273 274 END SUBROUTINE trc_dtr 275 276 #else 277 278 SUBROUTINE trc_dtr 279 !!====================== 280 !! no passive tracers 281 !!====================== 282 END SUBROUTINE trc_dtr 283 #endif 284 255 !!====================================================================== 285 256 END MODULE trcdtr -
trunk/NEMO/TOP_SRC/trcini.F90
r719 r945 1 1 MODULE trcini 2 !!========================================================================== 3 !! *** MODULE trcini *** 4 !! Ocean passive tracers: Manage the passive tracer initialization 5 !!========================================================================= 6 #if defined key_passivetrc 2 !!====================================================================== 3 !! *** MODULE trcini *** 4 !! TOP : Manage the passive tracer initialization 5 !!====================================================================== 6 !! History : - ! 2000-04 (O. Aumont, M.A. Foujols) original code 7 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 8 !! - ! 2005-10 (C. Ethe) Module 9 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) re-writing 7 10 !!---------------------------------------------------------------------- 8 !! trc_ini : Initialization for passive tracer11 !! trc_ini : Initialization for passive tracer 9 12 !!---------------------------------------------------------------------- 10 !!---------------------------------------------------------------------- 11 !! TOP 1.0, LOCEAN-IPSL (2005) 12 !! $Header$ 13 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 14 !!---------------------------------------------------------------------- 15 !! * Modules used 16 USE oce_trc 17 USE trc 18 USE sms 19 USE lib_mpp 20 USE lbclnk 13 USE par_trc ! TOP parameters 14 USE trcini_cfc ! CFC initialisation 15 USE trcini_lobster ! LOBSTER initialisation 16 USE trcini_pisces ! PISCES initialisation 17 USE trcini_my_trc ! MY_TRC initialisation 18 USE in_out_manager ! I/O manager 21 19 22 20 IMPLICIT NONE 23 21 PRIVATE 24 22 25 !! * Accessibility 26 PUBLIC trc_ini 23 PUBLIC trc_ini ! called by ??? 27 24 28 #if defined key_trc_lobster129 25 !!---------------------------------------------------------------------- 30 !! 'key_trc_lobster1' LOBSTER1 biological model 31 !!---------------------------------------------------------------------- 32 # include "trcini.lobster1.h90" 33 34 #elif defined key_trc_pisces 35 !!---------------------------------------------------------------------- 36 !! 'key_trc_pisces' PISCES biological model 37 !!---------------------------------------------------------------------- 38 # include "trcini.pisces.h90" 39 40 #elif defined key_cfc 41 !!---------------------------------------------------------------------- 42 !! 'key_cfc ' CFC model 43 !!---------------------------------------------------------------------- 44 # include "trcini.cfc.h90" 45 46 #else 47 !!---------------------------------------------------------------------- 48 !! Default option 26 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 27 !! $Header:$ 28 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 29 !!---------------------------------------------------------------------- 50 30 … … 52 32 53 33 SUBROUTINE trc_ini 54 !!------------------------------------------------------------------- --34 !!------------------------------------------------------------------- 55 35 !! *** ROUTINE trc_ini *** 56 36 !! 57 !! ** Purpose : Initialization for passive tracer 58 !! for restart or not 37 !! ** Purpose : Initialization of passive tracer to zero 59 38 !! 60 !! History : 61 !! ! 00-04 O. Aumont, M.A. Foujols HAMOCC3 and P3ZD 62 !! 8.5 ! 05-03 O.Aumont and A.El Moussaoui F90 63 !! 9.0 ! 05-10 C. Ethe Modularity 64 !!---------------------------------------------------------------------- 65 !! * local declarations 66 INTEGER :: & 67 ji ,jj ,jk ,jn, jl ! dummy loop indices 68 !!--------------------------------------------------------------------- 69 70 71 !! 1. initialization of passives tracers field 72 !! ------------------------------------------- 73 DO jn = 1, jptra 74 trn(:,:,:,jn)=0.e0 75 tra(:,:,:,jn)=0.e0 76 END DO 77 78 #if defined key_trc_diaadd 79 !! initialization of output 2d and 3d arrays 80 81 DO jn = 1, jpdia2d 82 trc2d(:,:,jn)=0.e0 83 END DO 84 85 DO jn = 1, jpdia3d 86 trc3d(:,:,:,jn)=0.e0 87 END DO 88 #endif 89 90 #if defined key_trc_diabio 91 !! initialization of biological trends 92 DO jn=1,jpdiabio 93 trbio(:,:,:,jn) = 0.e0 94 END DO 95 #endif 96 97 #if defined key_trc_diatrd 98 !! initialization of tracer trends 99 DO jl = 1, jpdiatrc 100 DO jn = 1, jptra 101 IF (luttrd(jn)) trtrd(:,:,:,ikeep(jn),jl) = 0.e0 102 END DO 103 END DO 104 #endif 105 106 IF( lwp ) THEN 107 WRITE(numout,*) ' ' 108 WRITE(numout,*) ' trcini: generic initialisation done ' 109 WRITE(numout,*) ' ' 39 !! ** Method : call the initialisation of each defined tracer 40 !! model (LOBSTER, PISCES, CFC, MY_TRC) 41 !!------------------------------------------------------------------- 42 ! 43 IF(lwp) WRITE(numout,*) 44 IF(lwp) WRITE(numout,*) 'trc_ini : initial set up of the tracer models' 45 IF(lwp) WRITE(numout,*) '~~~~~~~' 46 ! 47 IF( lk_lobster ) THEN ; CALL trc_ini_lobster ! LOBSTER bio-model 48 ELSE ; IF(lwp) WRITE(numout,*) ' LOBSTER not used' 110 49 ENDIF 111 50 51 IF( lk_pisces ) THEN ; CALL trc_ini_pisces ! PISCES bio-model 52 ELSE ; IF(lwp) WRITE(numout,*) ' PISCES not used' 53 ENDIF 54 55 IF( lk_cfc ) THEN ; CALL trc_ini_cfc ! CFC tracers 56 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used' 57 ENDIF 58 59 IF( lk_my_trc ) THEN ; CALL trc_ini_my_trc ! MY_TRC tracers 60 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 61 ENDIF 62 ! 112 63 END SUBROUTINE trc_ini 113 114 #endif115 116 #else117 !!----------------------------------------------------------------------118 !! Dummy module : NO passive tracer119 !!----------------------------------------------------------------------120 CONTAINS121 SUBROUTINE trc_ini ! Empty routine122 123 END SUBROUTINE trc_ini124 #endif125 64 126 65 !!====================================================================== -
trunk/NEMO/TOP_SRC/trclec.F90
r719 r945 1 1 MODULE trclec 2 !!========================================================================== 3 !! 4 !! *** MODULE trclec *** 5 !! Read and print options for the passive tracer run (namelist) 6 !! O.Aumont and A.El Moussaoui 03/05 F90 7 !!========================================================================= 8 !! TOP 1.0, LOCEAN-IPSL (2005) 9 !! $Header$ 10 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 11 !!---------------------------------------------------------------------- 12 #if defined key_passivetrc 13 !! * Modules used 14 !! ============== 2 !!====================================================================== 3 !! *** MODULE trclec *** 4 !! TOP : Read and print options for the passive tracer run (namelist) 5 !!====================================================================== 6 !! History : - ! 1996-11 (M.A. Foujols, M. Levy) original code 7 !! - ! 1998-04 (M.A Foujols, L. Bopp) ahtrb0 for isopycnal mixing 8 !! - ! 1999-10 (M.A. Foujols, M. Levy) separation of sms 9 !! - ! 2000-07 (A. Estublier) add TVD and MUSCL : Tests on ndttrc 10 !! - ! 2000-11 (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0 11 !! - ! 2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes 12 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 13 !!---------------------------------------------------------------------- 14 #if defined key_top 15 !!---------------------------------------------------------------------- 16 !! 'key_top' TOP models 17 !!---------------------------------------------------------------------- 18 !! trc_lec : Read and print options for the passive tracer run (namelist) 19 !!---------------------------------------------------------------------- 15 20 USE oce_trc 16 21 USE trc … … 21 26 PRIVATE 22 27 23 !! * Accessibility 24 PUBLIC trc_lec 25 26 #include "passivetrc_substitute.h90" 28 PUBLIC trc_lec ! called in ??? 29 30 !! * Substitutions 31 # include "top_substitute.h90" 32 !!---------------------------------------------------------------------- 33 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 34 !! $Header:$ 35 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 36 !!---------------------------------------------------------------------- 27 37 28 38 CONTAINS … … 30 40 SUBROUTINE trc_lec 31 41 !!--------------------------------------------------------------------- 32 !! ROUTINE trclec 33 !! ****************** 34 !! PURPOSE : 35 !! --------- 36 !! READ and PRINT options for the passive tracer run (namelist) 42 !! *** ROUTINE trc_lec *** 37 43 !! 38 !! History: 39 !! -------- 40 !! original : 96-11 (M.A. Foujols, M. Levy) passive tracer 41 !! modification : 98-04 (M.A Foujols, L. Bopp) ahtrb0 for isopycnal 42 !! diffusion 43 !! modification : 99-10(M.A. Foujols, M. Levy) separation of sms 44 !! additions : 00-05(A. Estublier) TVD Limiter Scheme : Tests 45 !! on ndttrc 46 !! additions : 00-06(A. Estublier) MUSCL Scheme : Tests 47 !! on ndttrc 48 !! additions : 00-07(A. Estublier) PPM Scheme : Tests on ndttrc 49 !! modification : 00-11 (M.A Foujols, E Kestenare) trcrat, ahtrc0 and aeivtr0 50 !! modification : 01-01 (E Kestenare) suppress ndttrc=1 51 !! for Arakawa and TVD schemes 52 !! O.Aumont and A.El Moussaoui 03/05 F90 53 !!---------------------------------------------------------------------- 54 55 !! local declarations 56 !! ================== 57 58 INTEGER :: ji 59 CHARACTER (len=32) :: clname 60 44 !! ** Purpose : READ and PRINT options for the passive tracer run (namelist) 45 !! 46 !! ** Method : - read namelist 61 47 !!--------------------------------------------------------------------- 62 !! OPA.90 03/2005 48 INTEGER :: jn 49 CHARACTER (len=32) :: clname 50 51 TYPE PTRACER 52 CHARACTER(len = 20) :: sname 53 CHARACTER(len = 80 ) :: lname 54 CHARACTER(len = 20 ) :: unit 55 LOGICAL :: lini 56 LOGICAL :: lsav 57 END TYPE PTRACER 58 59 #if defined key_trc_diaadd 60 61 TYPE DIAG 62 CHARACTER(len = 20) :: snamedia 63 CHARACTER(len = 80 ) :: lnamedia 64 CHARACTER(len = 20 ) :: unitdia 65 END TYPE DIAG 66 67 #endif 68 69 TYPE(PTRACER) , DIMENSION(jptra) :: tracer 70 71 #if defined key_trc_diaadd 72 TYPE(DIAG) , DIMENSION(jpdia2d) :: diag2d 73 TYPE(DIAG) , DIMENSION(jpdia3d) :: diag3d 74 #endif 75 76 !! 77 NAMELIST/nattrc/ nwritetrc, lrsttr, nrsttr, tracer 78 NAMELIST/natnum/ rsc, rtrn, ncortrc, ndttrc, crosster 79 #if defined key_trc_diatrd 80 NAMELIST/natrtd/ luttrd, nwritetrd ! dynamical trends 81 #endif 82 #if defined key_trc_diaadd 83 NAMELIST/natdia/nwritedia, diag3d, diag2d ! additional diagnostics 84 #endif 63 85 !!--------------------------------------------------------------------- 64 86 65 !! 0. initializations 66 !! ------------------ 67 68 namelist/nattrc/nwritetrc,lrsttr,nrsttr, ctrcnm,ctrcnl,ctrcun,lutini !general 69 70 namelist/natnum/rsc,rtrn,ncortrc,ndttrc,crosster 71 72 #if defined key_trc_diatrd 73 namelist/natrtd/luttrd,nwritetrd ! dynamical trends 74 #endif 75 76 #if defined key_trc_diaadd 77 namelist/natadd/ctrc3d,ctrc3l,ctrc2d,ctrc2l, ctrc3u, ctrc2u, & 78 nwriteadd !additional diagnostics 79 #endif 80 81 IF(lwp) THEN 82 WRITE(numout,*) ' ' 83 WRITE(numout,*) ' ROUTINE trclec' 84 WRITE(numout,*) ' **************' 85 WRITE(numout,*) ' ' 86 WRITE(numout,*) ' namelist for passive tracer' 87 WRITE(numout,*) ' ***************************' 88 WRITE(numout,*) ' ' 89 ENDIF 90 91 clname='namelist.passivetrc' 87 IF(lwp) WRITE(numout,*) 'trc_lec : read the passive tracer namelists' 88 IF(lwp) WRITE(numout,*) '~~~~~~~' 89 90 clname = 'namelist.passivetrc' 92 91 CALL ctlopn( numnat, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & 93 92 & 1, numout, .FALSE., 1 ) 94 93 95 94 96 !! 1., 2. & 3. initialization with namelist files 97 !! ---------------------------------------------- 98 !! 1.0 namelist nattrc : 99 100 nwritetrc = 10 101 lrsttr=.FALSE. 102 nrsttr = 0 103 104 DO ji=1,jptra 105 WRITE (ctrcnm(ji),'("TR_",I1)') ji 106 WRITE (ctrcnl(ji),'("TRACER NUMBER ",I1)') ji 107 ctrcun(ji)='mmole/m3' 108 lutini(ji)=.FALSE. 109 END DO 110 111 112 REWIND(numnat) 113 READ(numnat,nattrc) 114 115 IF(lwp) THEN 116 WRITE(numout,*) ' ' 117 WRITE(numout,*) 'nattrc' 118 WRITE(numout,*) ' ' 119 WRITE(numout,*) & 120 ' frequency of outputs for passive tracers nwritetrc = ' & 121 ,nwritetrc 122 WRITE(numout,*) ' restart LOGICAL for passive tr. lrsttr = ', & 123 & lrsttr 124 WRITE(numout,*) ' control of time step for p. tr. nrsttr = ', & 125 & nrsttr 126 DO ji=1,jptra 127 WRITE(numout,*) ' tracer nb: ',ji,' name = ',ctrcnm(ji) & 128 & ,ctrcnl(ji) 129 WRITE(numout,*) ' in unit = ',ctrcun(ji) 130 WRITE(numout,*) ' initial value in FILE : ',lutini(ji) 95 ! Namelist nattrc (files) 96 ! ---------------------------------------------- 97 nwritetrc = 10 ! default values 98 lrsttr = .FALSE. 99 nrsttr = 0 100 DO jn = 1, jptra 101 WRITE(ctrcnm(jn),'("TR_",I1)' ) jn 102 WRITE(ctrcnl(jn),'("TRACER NUMBER ",I1)') jn 103 ctrcun(jn) = 'mmole/m3' 104 lutini(jn) = .FALSE. 105 lutsav(jn) = .TRUE. 106 END DO 107 108 REWIND( numnat ) ! read nattrc 109 READ ( numnat, nattrc ) 110 111 DO jn = 1, jptra 112 ctrcnm(jn) = tracer(jn)%sname 113 ctrcnl(jn) = tracer(jn)%lname 114 ctrcun(jn) = tracer(jn)%unit 115 lutini(jn) = tracer(jn)%lini 116 lutsav(jn) = tracer(jn)%lsav 117 END DO 118 119 120 121 IF(lwp) THEN ! control print 122 WRITE(numout,*) 123 WRITE(numout,*) ' Namelist : nattrc' 124 WRITE(numout,*) ' frequency of outputs for passive tracers nwritetrc = ', nwritetrc 125 WRITE(numout,*) ' restart LOGICAL for passive tr. lrsttr = ', lrsttr 126 WRITE(numout,*) ' control of time step for p. tr. nrsttr = ', nrsttr 127 DO jn = 1, jptra 128 WRITE(numout,*) ' tracer nb : ', jn 129 WRITE(numout,*) ' short name : ', TRIM(ctrcnm(jn)) 130 WRITE(numout,*) ' long name : ', TRIM(ctrcnl(jn)) 131 WRITE(numout,*) ' unit : ', TRIM(ctrcun(jn)) 132 WRITE(numout,*) ' initial value in FILE : ', lutini(jn) 133 WRITE(numout,*) ' output of tracer : ', lutsav(jn) 131 134 WRITE(numout,*) ' ' 132 135 END DO 133 WRITE(numout,*) ' '134 136 ENDIF 135 137 136 138 #if defined key_trc_diatrd 137 139 138 !! 1.2 namelist nattrd : passive tracers dynamical trends 139 140 nwritetrd=10 141 142 !! default : no dynamical trend recording 143 !! -------------------------------------- 144 DO ji=1,jptra 145 luttrd(ji) = .FALSE. 146 END DO 147 148 REWIND(numnat) 149 READ(numnat,natrtd) 140 ! Namelist natrtd (transport trends) 141 ! ---------------------------------------------- 142 nwritetrd = 10 ! default values (no dynamical trend recording) 143 DO jn = 1, jptra 144 luttrd(jn) = .FALSE. 145 END DO 146 147 REWIND( numnat ) ! read natrtd 148 READ ( numnat, natrtd ) 150 149 151 150 nkeep=0 152 151 ikeep(:)=0 153 DO j i=1,jptra154 IF (luttrd(ji)) THEN155 nkeep =nkeep+1156 ikeep(j i)=nkeep152 DO jn = 1, jptra 153 IF( luttrd(jn) ) THEN 154 nkeep = nkeep + 1 155 ikeep(jn)=nkeep 157 156 END IF 158 157 END DO 159 IF (nkeep.GT.0) THEN160 IF (.NOT. ALLOCATED(trtrd)) ALLOCATE(trtrd(jpi,jpj,jpk,nkeep,jpdiatrc))161 trtrd(:,:,:,:,:) =0.0158 IF( nkeep > 0 ) THEN 159 IF(.NOT. ALLOCATED( trtrd ) ) ALLOCATE( trtrd(jpi,jpj,jpk,nkeep,jpdiatrc) ) 160 trtrd(:,:,:,:,:) = 0.e0 162 161 ENDIF 163 IF(lwp) THEN 164 WRITE(numout,*) 'natrtd' 165 WRITE(numout,*) ' ' 166 WRITE(numout,*) & 167 ' frequency of outputs for dynamical trends nwritetrd = ' & 168 ,nwritetrd 169 DO ji=1,jptra 170 WRITE(numout,*) & 171 ' keep dynamical trends for tracer number :',ji & 172 ,luttrd(ji), ikeep(ji) 173 END DO 174 WRITE(numout,*) 'total = ',nkeep,' tracers dyn trends saved' 175 WRITE(numout,*) 'size of trtrd = ',jpi*jpj*jpk*nkeep*jpdiatrc 176 ENDIF 177 #endif 178 179 !!1.3 namelist natadd : passive tracers diagnostics 180 !!------------------------------------------------- 181 182 #if defined key_trc_diaadd 183 184 nwriteadd = 10 185 186 !! default value for 3D output arrays : short and long name, units 187 188 DO ji=1,jpdia3d 189 WRITE (ctrc3d(ji),'("3D_",I1)') ji 190 WRITE (ctrc3l(ji),'("3D DIAGNOSTIC NUMBER ",I2)') ji 191 ctrc3u(ji)=' ' 192 END DO 193 194 195 !! default value for 2D output arrays : short and long name, units 196 !! --------------------------------------------------------------- 197 DO ji=1,jpdia2d 198 WRITE (ctrc2d(ji),'("2D_",I1)') ji 199 WRITE (ctrc2l(ji),'("2D DIAGNOSTIC NUMBER ",I2)') ji 200 ctrc2u(ji)=' ' 201 END DO 202 203 REWIND(numnat) 204 READ(numnat,natadd) 205 206 IF(lwp) THEN 207 WRITE(numout,*) ' natadd' 208 WRITE(numout,*) ' ' 209 WRITE(numout,*) & 210 ' frequency of outputs for additional arrays nwriteadd = ' & 211 ,nwriteadd 212 DO ji=1,jpdia3d 213 WRITE(numout,*) & 214 'name of 3d output field number :',ji,' : ',ctrc3d(ji) 215 WRITE(numout,*) ctrc3l(ji) 216 WRITE(numout,*) ' in unit = ',ctrc3u(ji) 217 END DO 218 WRITE(numout,*) ' ' 219 DO ji=1,jpdia2d 220 WRITE(numout,*) & 221 'name of 2d output field number :',ji,' : ',ctrc2d(ji) 222 WRITE(numout,*) ctrc2l(ji) 223 WRITE(numout,*) ' in unit = ',ctrc2u(ji) 224 END DO 225 WRITE(numout,*) ' ' 226 ENDIF 227 #endif 228 229 !! 1.1 namelist natnum : 230 !! --------------------- 231 rsc=1. 232 rtrn=1.e-15 233 ncortrc=1 234 ndttrc=4 235 crosster=.FALSE. 236 237 REWIND(numnat) 238 READ(numnat,natnum) 239 240 !!Chris computes the first time step of tracer model 162 163 IF(lwp) THEN ! control print 164 WRITE(numout,*) 165 WRITE(numout,*) ' Namelist : natrtd' 166 WRITE(numout,*) ' frequency of outputs for dynamical trends nwritetrd = ', nwritetrd 167 DO jn = 1, jptra 168 WRITE(numout,*) ' keep dynamical trends for tracer number :', jn, luttrd(jn), ikeep(jn) 169 END DO 170 WRITE(numout,*) ' total = ', nkeep, ' tracers dyn trends saved' 171 WRITE(numout,*) ' size of trtrd = ', jpi*jpj*jpk*nkeep*jpdiatrc 172 ENDIF 173 #endif 174 175 #if defined key_trc_diaadd 176 177 ! Namelist natrtd (transport trends) 178 ! ---------------------------------------------- 179 nwritedia = 10 ! default values 180 ! ! 2D output arrays 181 DO jn = 1, jpdia2d 182 WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name 183 WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name 184 ctrc2u(jn) = ' ' ! units 185 END DO 186 187 ! ! 3D output arrays 188 DO jn = 1, jpdia3d 189 WRITE(ctrc3d(jn),'("3D_",I1)') jn ! short name 190 WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn ! long name 191 ctrc3u(jn) = ' ' ! units 192 END DO 193 194 REWIND( numnat ) ! read natrtd 195 READ ( numnat, natdia ) 196 197 DO jn = 1, jpdia2d 198 ctrc2d(jn) = diag2d(jn)%snamedia 199 ctrc2l(jn) = diag2d(jn)%lnamedia 200 ctrc2u(jn) = diag2d(jn)%unitdia 201 END DO 202 203 DO jn = 1, jpdia3d 204 ctrc3d(jn) = diag3d(jn)%snamedia 205 ctrc3l(jn) = diag3d(jn)%lnamedia 206 ctrc3u(jn) = diag3d(jn)%unitdia 207 END DO 208 209 IF(lwp) THEN ! control print 210 WRITE(numout,*) 211 WRITE(numout,*) ' Namelist : natadd' 212 WRITE(numout,*) ' frequency of outputs for additional arrays nwritedia = ', nwritedia 213 DO jn = 1, jpdia3d 214 WRITE(numout,*) ' 3d output field No : ',jn 215 WRITE(numout,*) ' short name : ', TRIM(ctrc3d(jn)) 216 WRITE(numout,*) ' long name : ', TRIM(ctrc3l(jn)) 217 WRITE(numout,*) ' unit : ', TRIM(ctrc3u(jn)) 218 WRITE(numout,*) ' ' 219 END DO 220 221 DO jn = 1, jpdia2d 222 WRITE(numout,*) ' 2d output field No : ',jn 223 WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) 224 WRITE(numout,*) ' long name : ', TRIM(ctrc2l(jn)) 225 WRITE(numout,*) ' unit : ', TRIM(ctrc2u(jn)) 226 WRITE(numout,*) ' ' 227 END DO 228 ENDIF 229 #endif 230 231 !! Namelist natnum : 232 !! ----------------- 233 rsc = 1. ! default values 234 rtrn = 1.e-15 235 ncortrc = 1 236 ndttrc = 4 237 crosster = .FALSE. 238 239 REWIND( numnat ) ! read natnum 240 READ ( numnat, natnum ) 241 242 !!Chris computes the first time step of tracer model 241 243 nittrc000 = nit000 + ndttrc - 1 242 244 243 IF(lwp) THEN 244 WRITE(numout,*) ' ' 245 WRITE(numout,*) 'natnum' 246 WRITE(numout,*) ' ' 247 WRITE(numout,*) ' tuning coefficient rsc = ', & 248 rsc 249 WRITE(numout,*) ' truncation value rtrn = ', & 250 rtrn 251 WRITE(numout,*) ' number of corrective phase ncortrc = ', & 252 ncortrc 253 WRITE(numout,*) ' time step freq. for pass. trac. ndttrc = ', & 254 ndttrc 255 WRITE(numout,*) ' 1st time step for pass. trac. nittrc000 = ', & 256 nittrc000 257 WRITE(numout,*) ' computes or not crossterms crosster = ', & 258 crosster 259 ENDIF 260 261 262 !! namelist of transport 263 !! --------------------- 245 IF(lwp) THEN ! control print 246 WRITE(numout,*) 247 WRITE(numout,*) ' Namelist : natnum' 248 WRITE(numout,*) 249 WRITE(numout,*) ' tuning coefficient rsc = ', rsc 250 WRITE(numout,*) ' truncation value rtrn = ', rtrn 251 WRITE(numout,*) ' number of corrective phase ncortrc = ', ncortrc 252 WRITE(numout,*) ' time step freq. for pass. trac. ndttrc = ', ndttrc 253 WRITE(numout,*) ' 1st time step for pass. trac. nittrc000 = ', nittrc000 254 WRITE(numout,*) ' computes or not crossterms crosster = ', crosster 255 ENDIF 256 257 ! namelist of transport 258 ! --------------------- 264 259 CALL trc_trp_lec 265 260 266 ! !namelist of SMS267 ! !---------------261 ! namelist of SMS 262 ! --------------- 268 263 CALL trc_lsm 269 264 ! 270 265 END SUBROUTINE trc_lec 271 266 272 267 #else 268 !!---------------------------------------------------------------------- 269 !! Dummy module : No passive tracer 270 !!---------------------------------------------------------------------- 271 CONTAINS 272 SUBROUTINE trc_lec ! Empty routine 273 END SUBROUTINE trc_lec 274 #endif 275 273 276 !!====================================================================== 274 !! Empty module : No passive tracer275 !!======================================================================276 CONTAINS277 278 SUBROUTINE trc_lec279 280 END SUBROUTINE trc_lec281 282 #endif283 284 277 END MODULE trclec -
trunk/NEMO/TOP_SRC/trclsm.F90
r719 r945 1 1 MODULE trclsm 2 !!=============================================================== 3 !! 4 !! *** MODULE trclsm ****5 !! 6 !! READS specific NAMELIST for sms terms7 !! 8 !! =================================================================9 !! TOP 1.0, LOCEAN-IPSL (2005) 10 !! $Header$11 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt12 !!----------------------------------------------------------------- 13 #if defined key_passivetrc 14 !!------------------------------------------------------------- 15 !! * Modules used16 !! ==============17 USE oce_trc18 USE trc 19 USE sms20 2 !!====================================================================== 3 !! *** MODULE trclsm *** 4 !! TOP : reads specific namelist for passive tracer sms terms 5 !!====================================================================== 6 !! History : 1.0 ! 2004-03 (C. Ethe) Original code 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) re-writing 8 !!---------------------------------------------------------------------- 9 #if defined key_top 10 !!---------------------------------------------------------------------- 11 !! 'key_top' TOP models 12 !!---------------------------------------------------------------------- 13 !! trc_lsm : reads specific namelist for sms terms 14 !!---------------------------------------------------------------------- 15 USE par_trc ! TOP parameters 16 USE trclsm_cfc ! CFC initialisation 17 USE trclsm_lobster ! LOBSTER initialisation 18 USE trclsm_pisces ! PISCES initialisation 19 USE trclsm_my_trc ! MY_TRC initialisation 20 USE in_out_manager ! I/O manager 21 21 22 22 IMPLICIT NONE 23 23 PRIVATE 24 24 25 !! * Accessibility 26 PUBLIC trc_lsm 27 28 29 #if defined key_trc_lobster1 30 !!---------------------------------------------------------------------- 31 !! 'key_trc_lobster1' LOBSTER1 biological model 32 !!---------------------------------------------------------------------- 33 # include "trclsm.lobster1.h90" 34 35 #elif defined key_trc_pisces 36 !!---------------------------------------------------------------------- 37 !! 'key_trc_pisces' PISCES biological model 38 !!---------------------------------------------------------------------- 39 # include "trclsm.pisces.h90" 40 41 #elif defined key_cfc 42 !!---------------------------------------------------------------------- 43 !! 'key_cfc ' CFC model 44 !!---------------------------------------------------------------------- 45 # include "trclsm.cfc.h90" 25 PUBLIC trc_lsm ! called in initrc.F90 46 26 47 27 !!---------------------------------------------------------------------- 48 !! Default option 28 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 29 !! $Id$ 30 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 49 31 !!---------------------------------------------------------------------- 50 # endif51 52 #else53 32 54 33 CONTAINS 55 34 56 35 SUBROUTINE trc_lsm 57 !!================ 58 !! no passive tracers 59 END SUBROUTINE trc_lsm 36 !!---------------------------------------------------------------------- 37 !! *** trc_lsm *** 38 !! 39 !! ** Purpose : read TOP namelists for the different tracers models 40 !! 41 !! ** Method : call the namelist read of each defined tracer 42 !! model (LOBSTER, PISCES, CFC, MY_TRC) 43 !!---------------------------------------------------------------------- 44 ! 45 IF(lwp) WRITE(numout,*) 46 IF(lwp) WRITE(numout,*) 'trc_lsm : read namelist of the TOP models' 47 IF(lwp) WRITE(numout,*) '~~~~~~~' 48 ! 49 IF( lk_lobster ) THEN ; CALL trc_lsm_lobster ! LOBSTER bio-model 50 ELSE ; IF(lwp) WRITE(numout,*) ' LOBSTER not used' 51 ENDIF 60 52 53 IF( lk_pisces ) THEN ; CALL trc_lsm_pisces ! PISCES bio-model 54 ELSE ; IF(lwp) WRITE(numout,*) ' PISCES not used' 55 ENDIF 56 57 IF( lk_cfc ) THEN ; CALL trc_lsm_cfc ! CFC tracers 58 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used' 59 ENDIF 60 61 IF( lk_my_trc ) THEN ; CALL trc_lsm_my_trc ! MY_TRC tracers 62 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 63 ENDIF 64 ! 65 END SUBROUTINE trc_lsm 66 67 #else 68 !!---------------------------------------------------------------------- 69 !! Dummy module : No passive tracer 70 !!---------------------------------------------------------------------- 71 CONTAINS 72 SUBROUTINE trc_lsm ! Empty routine 73 END SUBROUTINE trc_lsm 61 74 #endif 62 75 76 !!====================================================================== 63 77 END MODULE trclsm -
trunk/NEMO/TOP_SRC/trcrst.F90
r899 r945 1 1 MODULE trcrst 2 2 !!====================================================================== 3 !! 4 !! *** MODULE trcrst *** 5 !! 6 !! Read the restart files for passive tracers 7 !! 3 !! *** MODULE trcrst *** 4 !! TOP : create, write, read the restart files for passive tracers 8 5 !!====================================================================== 9 !! TOP 1.0, LOCEAN-IPSL (2005) 10 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcrst.F90,v 1.11 2007/10/17 14:48:56 opalod Exp $ 11 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 12 !!---------------------------------------------------------------------- 13 #if defined key_passivetrc 14 !!---------------------------------------------------------------------- 15 !! * Modules used 16 !! ============== 6 !! History : 1.0 ! 2007-02 (C. Ethe) adaptation from the ocean 7 !!---------------------------------------------------------------------- 8 #if defined key_top 9 !!---------------------------------------------------------------------- 10 !! 'key_top' TOP models 11 !!---------------------------------------------------------------------- 12 !! trc_rst_opn : open restart file 13 !! trc_rst_read : read restart file 14 !! trc_rst_wri : write restart file 15 !!---------------------------------------------------------------------- 17 16 USE oce_trc 18 17 USE trc 19 18 USE sms 19 USE trcsms_cfc ! CFC variables 20 20 USE trctrp_lec 21 21 USE lib_mpp … … 25 25 PRIVATE 26 26 27 !! * Accessibility 28 PUBLIC trc_rst_opn 29 PUBLIC trc_rst_read 30 PUBLIC trc_rst_wri 31 32 !! * Module variables 27 PUBLIC trc_rst_opn ! called by ??? 28 PUBLIC trc_rst_read ! called by ??? 29 PUBLIC trc_rst_wri ! called by ??? 30 33 31 LOGICAL, PUBLIC :: lrst_trc !: logical to control the trc restart write 34 32 INTEGER, PUBLIC :: numrtr, numrtw !: logical unit for trc restart (read and write) 35 33 34 REAL(wp) :: & 35 alkmean = 2426. , & ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 36 po4mean = 2.165 , & ! mean value of phosphates 37 no3mean = 30.90 , & ! mean value of nitrate 38 siomean = 91.51 ! mean value of silicate 36 39 37 40 !! * Substitutions 38 # include "passivetrc_substitute.h90" 41 # include "top_substitute.h90" 42 !!---------------------------------------------------------------------- 43 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 44 !! $Id$ 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 46 !!---------------------------------------------------------------------- 39 47 40 48 CONTAINS … … 52 60 !!---------------------------------------------------------------------- 53 61 ! 54 55 62 IF( kt == nit000 ) THEN 56 63 lrst_trc = .FALSE. 57 # if defined key_off_tra64 # if defined key_off_tra 58 65 nitrst = nitend ! in online version, already done in rst_opn routine defined in restart.F90 module 59 # endif66 # endif 60 67 ENDIF 61 68 … … 63 70 ! beware if model runs less than 2*ndttrc time step 64 71 ! beware of the format used to write kt (default is i8.8, that should be large enough) 65 IF( nitrst > 1.0e9 ) THEN 66 WRITE(clkt,*) nitrst 67 ELSE 68 WRITE(clkt,'(i8.8)') nitrst 72 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 73 ELSE ; WRITE(clkt,'(i8.8)') nitrst 69 74 ENDIF 70 75 ! create the file … … 80 85 81 86 SUBROUTINE trc_rst_read 82 !!=========================================================================================== 87 !!---------------------------------------------------------------------- 88 !! *** trc_rst_opn *** 83 89 !! 84 !! ROUTINE trc_rst_read 85 !! ******************* 86 !! 87 !! PURPOSE : 88 !! --------- 89 !! READ files for restart for passive tracer 90 !! 91 !! METHOD : 92 !! ------- 93 !! READ the previous fields on the FILE nutrst 94 !! the first record indicates previous characterics 95 !! after control with the present run, we READ : 96 !! - prognostic variables on the second and more record 97 !! 98 !! History: 99 !! -------- 100 !! original : 96-11 101 !! 00-05 (A. Estublier) TVD Limiter Scheme key_trc_tvd 102 !! 00-12 (O. Aumont, E. Kestenare) read restart file for sediments 103 !! 01-05 (O. Aumont, E. Kestenare) read restart file for calcite and silicate sediments 104 !! 05-03 (O. Aumont and A. El Moussaoui) F90 105 !!------------------------------------------------------------------------ 106 INTEGER :: ji, jj, jk, jn 107 INTEGER :: iarak0 108 REAL(wp) :: zkt, zarak0 109 REAL(wp) :: caralk, bicarb, co3 110 111 #if defined key_trc_pisces 112 # if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 113 REAL(wp) :: ztrasum 114 # endif 115 #endif 116 117 !!--------------------------------------------------------------------- 118 !! OPA.9 03-2005 119 !!--------------------------------------------------------------------- 120 !! 0. initialisations 121 !!------------------ 122 123 124 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN 125 iarak0 = 1 126 ELSE 127 iarak0 = 0 128 ENDIF 129 130 131 IF(lwp) WRITE(numout,*) ' ' 132 IF(lwp) WRITE(numout,*) ' *** trc_rst beginning of restart for' 133 IF(lwp) WRITE(numout,*) ' passive tracer' 134 IF(lwp) WRITE(numout,*) ' the present run :' 135 IF(lwp) WRITE(numout,*) ' with the time nit000 : ',nit000 136 IF(lwp) THEN 137 IF( iarak0 == 1 ) THEN 138 WRITE(numout,*) ' and before fields for Arakawa sheme ' 139 ENDIF 140 WRITE(numout,*) ' ' 141 ENDIF 90 !! ** purpose : read passive tracer fields in restart files 91 !!---------------------------------------------------------------------- 92 INTEGER :: jn 93 INTEGER :: iarak0 94 REAL(wp) :: zkt, zarak0 95 # if defined key_pisces 96 REAL(wp) :: ztrasum 97 INTEGER :: ji, jj, jk 98 REAL(wp) :: caralk, bicarb, co3 99 # endif 100 !!---------------------------------------------------------------------- 101 102 IF(lwp) WRITE(numout,*) 103 IF(lwp) WRITE(numout,*) 'trc_rst_read : read the TOP restart file' 104 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 105 106 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ; iarak0 = 1 107 ELSE ; iarak0 = 0 108 ENDIF 109 110 IF(lwp) WRITE(numout,*) 111 IF(lwp) WRITE(numout,*) ' the present run starts at the time step nit000 = ', nit000 112 IF(lwp .AND. iarak0 == 1 ) WRITE(numout,*) ' and needs previous fields for Arakawa sheme ??? ' 113 142 114 143 115 ! Time domain : restart 144 116 ! ------------------------- 145 146 IF(lwp) WRITE(numout,*)147 117 IF(lwp) WRITE(numout,*) 148 118 IF(lwp) WRITE(numout,*) ' *** passive tracer restart option' 149 119 SELECT CASE ( nrsttr ) 150 120 CASE ( 0 ) 151 IF(lwp) WRITE(numout,*) ' nrsttr = 0 no control of nit000'121 IF(lwp) WRITE(numout,*) ' nrsttr = 0 no control of nit000' 152 122 CASE ( 1 ) 153 IF(lwp) WRITE(numout,*) ' nrsttr = 1 we control the date of nit000'123 IF(lwp) WRITE(numout,*) ' nrsttr = 1 we control the date of nit000' 154 124 CASE ( 2 ) 155 IF(lwp) WRITE(numout,*) ' nrsttr = 2 the date adatrj is read in restart file'125 IF(lwp) WRITE(numout,*) ' nrsttr = 2 the date adatrj is read in restart file' 156 126 CASE DEFAULT 157 127 IF(lwp) WRITE(numout,*) ' ===>>>> nrsttr not equal 0, 1 or 2 : no control of the date' 158 IF(lwp) WRITE(numout,*) ' ================'128 IF(lwp) WRITE(numout,*) ' ======= =========' 159 129 END SELECT 160 130 161 CALL iom_open 131 CALL iom_open( 'restart.trc', numrtr, kiolib = jprstlib ) 162 132 163 133 CALL iom_get( numrtr, 'kt' , zkt ) … … 166 136 IF(lwp) WRITE(numout,*) 167 137 IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' 168 IF(lwp) WRITE(numout,*) ' time-step : ', NINT( zkt ) 169 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zarak0 ) 170 IF(lwp) WRITE(numout,*) 171 172 173 !! control of date 174 !! ------------------- 175 176 IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 ) & 177 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 178 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 179 180 !! Control of the scheme 181 !! ------------------------ 182 183 IF( iarak0 /= NINT( zarak0 ) ) & 184 & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 185 & ' it must be the same type for both restart and previous run', & 186 & ' centered or euler ' ) 187 188 189 !! ... READ prognostic variables and computes diagnostic variable 190 !! --------------------------------------------------------------- 191 138 IF(lwp) WRITE(numout,*) ' time-step : ', NINT( zkt ) 139 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zarak0 ) 140 141 142 IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 ) & ! control of date 143 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 144 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 145 146 IF( iarak0 /= NINT( zarak0 ) ) & ! Control of the scheme 147 & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 148 & ' it must be the same type for both restart and previous run', & 149 & ' centered or euler ' ) 150 151 152 ! READ prognostic variables and computes diagnostic variable 192 153 DO jn = 1, jptra 193 CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 154 CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 155 CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 194 156 END DO 195 196 DO jn = 1, jptra 197 CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 198 END DO 199 200 #if defined key_trc_lobster1 157 # if defined key_lobster 201 158 CALL iom_get( numrtr, jpdom_local, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 202 159 CALL iom_get( numrtr, jpdom_local, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 203 204 #elif defined key_trc_pisces 160 # elif defined key_pisces 205 161 CALL iom_get( numrtr, jpdom_local, 'Silicalim', xksi(:,:) ) 206 xksimax = xksi 207 208 #elif defined key_cfc 162 CALL iom_get( numrtr, jpdom_local, 'Silicamax', xksimax(:,:) ) 163 # elif defined key_cfc 209 164 DO jn = 1, jptra 210 CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn),qint(:,:,jn)) 165 CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn), qint(:,:,jn) ) 166 CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) ) 211 167 END DO 212 DO jn = 1, jptra 213 CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) ,qtr( :,:,jn)) 214 END DO 215 #endif 216 217 218 #if defined key_trc_pisces 219 220 #if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 221 222 ztrasum = 0. 223 DO jk = 1, jpk 224 DO jj = 1, jpj 225 DO ji = 1, jpi 226 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 227 #if defined key_off_degrad 228 & * facvol(ji,jj,jk) & 229 #endif 230 231 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 232 END DO 233 END DO 234 END DO 235 236 IF( lk_mpp ) THEN 237 CALL mpp_sum( ztrasum ) ! sum over the global domain 238 END IF 239 240 WRITE(0,*) 'TALK moyen ', ztrasum/areatot*1E6 241 ztrasum = ztrasum/areatot*1E6 242 trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./ztrasum 243 244 ztrasum = 0. 245 DO jk = 1, jpk 246 DO jj = 1, jpj 247 DO ji = 1, jpi 248 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 249 #if defined key_off_degrad 250 & * facvol(ji,jj,jk) & 251 #endif 252 253 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 254 END DO 255 END DO 256 END DO 257 258 IF( lk_mpp ) THEN 259 CALL mpp_sum( ztrasum ) ! sum over the global domain 260 END IF 261 262 263 WRITE(0,*) 'PO4 moyen ', ztrasum/areatot*1E6/122. 264 ztrasum = ztrasum/areatot*1E6/122. 265 trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/ztrasum 266 267 ztrasum = 0. 268 DO jk = 1, jpk 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 272 #if defined key_off_degrad 273 & * facvol(ji,jj,jk) & 274 #endif 275 276 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 277 END DO 278 END DO 279 END DO 280 281 IF( lk_mpp ) THEN 282 CALL mpp_sum( ztrasum ) ! sum over the global domain 283 END IF 284 285 286 WRITE(0,*) 'NO3 moyen ', ztrasum/areatot*1E6/7.6 287 ztrasum = ztrasum/areatot*1E6/7.6 288 trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/ztrasum 289 290 ztrasum = 0. 291 DO jk = 1, jpk 292 DO jj = 1, jpj 293 DO ji = 1, jpi 294 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 295 #if defined key_off_degrad 296 & * facvol(ji,jj,jk) & 297 #endif 298 299 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 300 END DO 301 END DO 302 END DO 303 304 IF( lk_mpp ) THEN 305 CALL mpp_sum( ztrasum ) ! sum over the global domain 306 END IF 307 308 WRITE(0,*) 'SiO3 moyen ', ztrasum/areatot*1E6 309 ztrasum = ztrasum/areatot*1E6 310 trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/ztrasum) 311 312 #endif 313 314 !#if defined key_trc_kriest 168 # endif 169 170 # if defined key_pisces 171 ! ! --------------------------- ! 172 IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN ! ORCA condiguration (not 1D) ! 173 ! ! --------------------------- ! 174 ! set total alkalinity, phosphate, NO3 & silicate 175 ! total alkalinity 176 ! ----------------------------------------------- 177 ztrasum = 0.e0 178 DO jk = 1, jpk 179 DO jj = 1, jpj 180 DO ji = 1, jpi 181 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 182 # if defined key_off_degrad 183 & * facvol(ji,jj,jk) & 184 # endif 185 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 186 END DO 187 END DO 188 END DO 189 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 190 191 192 ztrasum = ztrasum / areatot * 1.e6 193 IF(lwp) WRITE(numout,*) 'TALK moyen ', ztrasum 194 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum 195 196 ! phosphate 197 ! --------- 198 ztrasum = 0.e0 199 DO jk = 1, jpk 200 DO jj = 1, jpj 201 DO ji = 1, jpi 202 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 203 # if defined key_off_degrad 204 & * facvol(ji,jj,jk) & 205 # endif 206 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 207 END DO 208 END DO 209 END DO 210 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 211 212 ztrasum = ztrasum / areatot * 1.e6 / 122. 213 IF(lwp) WRITE(numout,*) 'PO4 moyen ', ztrasum 214 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum 215 216 ! NO3 217 ! --- 218 ztrasum = 0.e0 219 DO jk = 1, jpk 220 DO jj = 1, jpj 221 DO ji = 1, jpi 222 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 223 # if defined key_off_degrad 224 & * facvol(ji,jj,jk) & 225 # endif 226 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 227 END DO 228 END DO 229 END DO 230 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 231 232 ztrasum = ztrasum / areatot * 1.e6 / 7.6 233 IF(lwp) WRITE(numout,*) 'NO3 moyen ', ztrasum 234 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum 235 236 ! Silicate 237 ! -------- 238 ztrasum = 0.e0 239 DO jk = 1, jpk 240 DO jj = 1, jpj 241 DO ji = 1, jpi 242 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 243 # if defined key_off_degrad 244 & * facvol(ji,jj,jk) & 245 # endif 246 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 247 END DO 248 END DO 249 END DO 250 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 251 252 IF(lwp) WRITE(numout,*) 'SiO3 moyen ', ztrasum / areatot * 1.e6 253 ztrasum = ztrasum / areatot * 1.e6 254 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum ) 255 ! 256 ENDIF 257 258 !#if defined key_kriest 315 259 ! !! Initialize number of particles from a standart restart file 316 260 ! !! The name of big organic particles jpgoc has been only change … … 319 263 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 320 264 !#endif 321 !! Initialization of chemical variables of the carbon cycle322 !! -------------------------------------------------------- 323 DO jk = 1, jpk324 DO jj = 1, jpj265 !! Set hi (???) from total alcalinity, borat (???), akb3 (???) and ak23 (???) 266 !! --------------------------------------------------------------------- 267 DO jk = 1, jpk 268 DO jj = 1, jpj 325 269 DO ji = 1,jpi 326 caralk = trn(ji,jj,jk,jptal)- & 327 & borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk))) 328 co3 = (caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk) & 329 & +(1.-tmask(ji,jj,jk))*.5e-3 330 bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk) 331 hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3) & 332 & *tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9 333 ENDDO 334 ENDDO 335 ENDDO 336 #endif 337 !CT comment the line below which doesn't ensure 338 !CT restartability of the GYRE_LOBSTER configuration 339 !CT trb(:,:,:,:) = trn(:,:,:,:) 270 caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) ) 271 co3 = ( caralk - trn(ji,jj,jk,jpdic) ) * tmask(ji,jj,jk) & 272 & + 0.5e-3 * ( 1.- tmask(ji,jj,jk) ) 273 bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk 274 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 ) * tmask(ji,jj,jk) & 275 & + 1.0e-9 * ( 1.- tmask(ji,jj,jk) ) 276 END DO 277 END DO 278 END DO 279 # endif 340 280 341 281 CALL iom_close( numrtr ) 342 343 282 ! 344 283 END SUBROUTINE trc_rst_read 345 284 346 SUBROUTINE trc_rst_wri(kt) 347 !! ================================================================================== 285 286 SUBROUTINE trc_rst_wri( kt ) 287 !!---------------------------------------------------------------------- 288 !! *** trc_rst_wri *** 348 289 !! 349 !! ROUTINE trc_rst_wri 350 !! ****************** 290 !! ** purpose : write passive tracer fields in restart files 291 !!---------------------------------------------------------------------- 292 INTEGER, INTENT( in ) :: kt ! ocean time-step index 351 293 !! 352 !! PURPOSE : 353 !! --------- 354 !! WRITE restart fields in nutwrs 355 !! METHOD : 356 !! ------- 357 !! 358 !! nutwrs FILE: 359 !! each nstock time step , SAVE fields which are necessary for 360 !! passive tracer restart 361 !! 362 !! 363 !! INPUT : 364 !! ----- 365 !! argument 366 !! kt : time step 367 !! COMMON 368 !! /cottrc/ : passive tracers fields (before,now 369 !! ,after) 370 !! 371 !! OUTPUT : 372 !! ------ 373 !! FILE 374 !! nutwrs : standard restart fields OUTPUT 375 !! 376 !! WORKSPACE : 377 !! --------- 378 !! ji,jj,jk,jn 379 !! 380 !! History: 381 !! -------- 382 !! original : 96-12 383 !! addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl 384 !! additions : 00-05 (A. Estublier) 385 !! TVD Limiter Scheme : key_trc_tvd 386 !! additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo 387 !! additions : 01-01 (O. Aumont, E. Kestenare) 388 !! write restart file for sediments 389 !! additions : 01-05 (O. Aumont, E. Kestenare) 390 !! write restart file for calcite and silicate sediments 391 !! 05-03 (O. Aumont and A. El Moussaoui) F90 392 !!========================================================================================! 393 394 !! * Arguments 395 !! ----------- 396 INTEGER, INTENT( in ) :: kt 397 398 !! * local declarations 399 !! ==================== 400 401 INTEGER :: ji,jj,jk,jn 294 INTEGER :: ji, jj, jk, jn 402 295 REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 403 296 REAL(wp) :: zder 404 405 406 !! 1. OUTPUT of restart fields (nutwrs) 407 !! --------------------------- 408 409 IF( MOD(kt,nstock) == 0 .OR. kt == nitend ) THEN 410 411 !! 0. initialisations 412 !! ------------------ 413 414 IF(lwp) WRITE(numout,*) ' ' 415 IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file in NetCDF format ', & 416 'at it= ',kt,' date= ',ndastp 417 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 297 !!---------------------------------------------------------------------- 298 299 IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN 300 301 ! 0. initialisations 302 ! ------------------ 303 IF(lwp) WRITE(numout,*) 304 IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp 305 IF(lwp) WRITE(numout,*) '~~~~~~~' 418 306 419 307 … … 429 317 ! prognostic variables 430 318 ! -------------------- 431 432 DO jn=1,jptra 319 DO jn = 1, jptra 433 320 CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 434 ENDDO435 436 DO jn=1,jptra437 321 CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 438 322 END DO 439 323 440 #if defined key_ trc_lobster1324 #if defined key_lobster 441 325 CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 442 326 CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 443 #elif defined key_ trc_pisces327 #elif defined key_pisces 444 328 CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 329 CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 445 330 446 331 #elif defined key_cfc 447 DO jn =1,jptra332 DO jn = 1, jptra 448 333 CALL iom_rstput( kt, nitrst, numrtw, 'qint'//ctrcnm(jn), qint(:,:,jn) ) 449 END DO 450 DO jn=1,jptra 451 CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) ) 334 CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr (:,:,jn) ) 452 335 END DO 453 336 #endif 454 337 455 IF (lwp) WRITE(numout,*) '----TRACER STAT----' 456 457 zdiag_tot=0. 458 DO jn=1,jptra 459 zdiag_var=0. 460 zdiag_varmin=0. 461 zdiag_varmax=0. 462 463 DO ji=1, jpi 464 DO jj=1, jpj 465 DO jk=1,jpk 466 zdiag_var=zdiag_var+trn(ji,jj,jk,jn)*tmask(ji,jj,jk)*tmask_i(ji,jj) & 338 IF(lwp) WRITE(numout,*) '----TRACER STAT----' 339 340 zdiag_tot = 0.e0 341 DO jn = 1, jptra 342 zdiag_var = 0.e0 343 zdiag_varmin = 0.e0 344 zdiag_varmax = 0.e0 345 DO ji = 1, jpi 346 DO jj = 1, jpj 347 DO jk = 1,jpk 348 zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 467 349 #if defined key_off_degrad 468 350 & * facvol(ji,jj,jk) & 469 351 #endif 470 352 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 471 472 353 END DO 473 354 END DO 474 355 END DO 475 356 476 zdiag_varmin =MINVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))477 zdiag_varmax =MAXVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))357 zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 358 zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 478 359 479 360 IF( lk_mpp ) THEN 480 CALL mpp_min( zdiag_varmin) ! min over the global domain481 CALL mpp_max( zdiag_varmax) ! max over the global domain482 CALL mpp_sum( zdiag_var)! sum over the global domain361 CALL mpp_min( zdiag_varmin ) ! min over the global domain 362 CALL mpp_max( zdiag_varmax ) ! max over the global domain 363 CALL mpp_sum( zdiag_var ) ! sum over the global domain 483 364 END IF 484 365 485 zdiag_tot=zdiag_tot+zdiag_var 486 zdiag_var=zdiag_var/areatot 487 488 IF (lwp) WRITE(numout,*) 'MEAN NO ',jn,ctrcnm(jn),' =',zdiag_var,'MIN= ' & 489 ,zdiag_varmin,'MAX= ',zdiag_varmax 490 491 END DO 492 493 zdiag_tot=zdiag_tot 494 zder=((zdiag_tot-trai)/trai)*100._wp 495 IF (lwp) WRITE(numout,*) 'Integral of all tracers over the full domain =',zdiag_tot 496 IF (lwp) WRITE(numout,*) 'Drift of the sum of all tracers =',zder, '%' 366 zdiag_tot = zdiag_tot + zdiag_var 367 zdiag_var = zdiag_var / areatot 368 369 IF(lwp) WRITE(numout,*) ' MEAN NO ', jn, ctrcnm(jn), ' = ', zdiag_var, & 370 & ' MIN = ', zdiag_varmin, ' MAX = ', zdiag_varmax 371 END DO 372 373 zder = ( ( zdiag_tot - trai ) / ( trai + 1.e-12 ) ) * 100._wp 374 IF(lwp) WRITE(numout,*) ' Integral of all tracers over the full domain = ', zdiag_tot 375 IF(lwp) WRITE(numout,*) ' Drift of the sum of all tracers =', zder, ' %' 497 376 498 377 CALL iom_close(numrtw) 499 500 ENDIF 501 378 ! 379 ENDIF 380 ! 502 381 END SUBROUTINE trc_rst_wri 503 382 504 505 383 #else 506 !! ======================================================================507 !! Empty module :No passive tracer508 !! ======================================================================384 !!---------------------------------------------------------------------- 385 !! Dummy module : No passive tracer 386 !!---------------------------------------------------------------------- 509 387 CONTAINS 510 511 SUBROUTINE trc_rst_read 512 !! no passive tracers 388 SUBROUTINE trc_rst_read ! Empty routines 513 389 END SUBROUTINE trc_rst_read 514 515 SUBROUTINE trc_rst_wri(kt) 516 !! no passive tracers 390 SUBROUTINE trc_rst_wri( kt ) 517 391 INTEGER, INTENT ( in ) :: kt 518 392 WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt 519 END SUBROUTINE trc_rst_wri 520 393 END SUBROUTINE trc_rst_wri 521 394 #endif 522 395 396 !!====================================================================== 523 397 END MODULE trcrst -
trunk/NEMO/TOP_SRC/trcsms.F90
r719 r945 1 1 MODULE trcsms 2 !!=========================================================================================== 3 !! 4 !! *** MODULE trcsms *** 5 !! 6 !! Time loop of opa for passive tracer 7 !! 8 !!=========================================================================================== 9 !! TOP 1.0, LOCEAN-IPSL (2005) 10 !! $Header$ 11 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 2 !!====================================================================== 3 !! *** MODULE trcsms *** 4 !! TOP : Time loop of passive tracers sms 5 !!====================================================================== 6 !! History : 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 12 8 !!---------------------------------------------------------------------- 13 #if defined key_passivetrc 14 !! * Modules used 15 !! ============== 16 USE oce_trc 17 USE trc 18 USE trcfreons 19 USE prtctl_trc ! Print control for debbuging 9 #if defined key_top 10 !!---------------------------------------------------------------------- 11 !! 'key_top' TOP models 12 !!---------------------------------------------------------------------- 13 !! trc_sms : Time loop of passive tracers sms 14 !!---------------------------------------------------------------------- 15 USE oce_trc ! 16 USE trc ! 17 USE trcsms_lobster ! LOBSTER bio-model 18 USE trcsms_pisces ! PISCES biogeo-model 19 USE trcsms_cfc ! CFC 11 & 12 20 USE trcsms_my_trc ! MY_TRC tracers 21 USE prtctl_trc ! Print control for debbuging 20 22 21 23 IMPLICIT NONE 22 24 PRIVATE 23 25 24 !! * Accessibility 25 PUBLIC trc_sms 26 PUBLIC trc_sms ! called in trcstp.F90 27 28 !!---------------------------------------------------------------------- 29 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 30 !! $Header:$ 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 32 !!---------------------------------------------------------------------- 26 33 27 34 CONTAINS 28 35 29 36 SUBROUTINE trc_sms( kt ) 30 !!=========================================================================================== 37 !!--------------------------------------------------------------------- 38 !! *** ROUTINE ini_trc *** 31 39 !! 32 !! ROUTINE trcsms 33 !! ***************** 40 !! ** Purpose : Managment of the time loop of passive tracers sms 34 41 !! 35 !! PURPOSE :36 !! 37 !! time loop of opa for passive tracer42 !! ** Method : - call the main routine of of each defined tracer model 43 !! ------------------------------------------------------------------------------------- 44 INTEGER, INTENT( in ) :: kt ! ocean time-step index 38 45 !! 39 !! METHOD : 40 !! ------- 41 !! compute the well/spring evolution 42 !! 43 !! INPUT : 44 !! ----- 45 !! argument 46 !! ktask : task identificator 47 !! kt : time step 48 !! COMMON 49 !! all the COMMON defined in opa 50 !! 51 !! 52 !! OUTPUT : : no 53 !! ------ 54 !! 55 !! WORKSPACE : 56 !! --------- 57 !! 58 !! EXTERNAL : 59 !! -------- 60 !! trcbio, trcsed, trcopt for NPZD or LOBSTER1 models 61 !! 62 !! h3cprg for HAMOC3 and P3ZD models 63 !! 64 !! 65 !! History: 66 !! -------- 67 !! original : 96-11 68 !! additions : 99-07 (M. Levy) 69 !! 04-00 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 70 !! 12-00 (O. Aumont, E. Kestenare) add trcexp for instantaneous export 71 !! 05-03 (O. Aumont and A. El Moussaoui) F90 72 !! ------------------------------------------------------------------------------------- 46 CHARACTER (len=25) :: charout 47 !!--------------------------------------------------------------------- 73 48 74 !! * Arguments 75 !! ----------- 76 INTEGER, INTENT( in ) :: kt ! ocean time-step index 49 IF ( MOD(kt,ndttrc) /= 0) RETURN ! this ROUTINE is called only every ndttrc time step 77 50 78 !! * Local variables 79 !! ----------------- 51 IF( lk_lobster ) CALL trc_sms_lobster( kt ) ! main program of LOBSTER 52 IF( lk_pisces ) CALL trc_sms_pisces ( kt ) ! main program of PISCES 53 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 54 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 80 55 81 CHARACTER (len=25) :: charout 82 83 !! this ROUTINE is called only every ndttrc time step 84 !! -------------------------------------------------- 85 86 IF ( MOD(kt,ndttrc) /= 0) RETURN 87 88 !! this first routines are parallelized on vertical slab 89 !! ------------------------------------------------------ 90 91 #if defined key_trc_lobster1 92 93 !! tracers: optical model 94 !! ---------------------- 95 96 CALL trcopt( kt) 97 98 IF(ln_ctl) THEN ! print mean trends (used for debugging) 99 WRITE(charout, FMT="('OPT')") 100 CALL prt_ctl_trc_info(charout) 101 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 56 IF(ln_ctl) THEN ! print mean trends (used for debugging) 57 WRITE(charout, FMT="('sms ')") 58 CALL prt_ctl_trc_info( charout ) 59 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 102 60 ENDIF 103 104 !! tracers: biological model 105 !! ------------------------- 106 107 CALL trcbio( kt) 108 109 IF(ln_ctl) THEN ! print mean trends (used for debugging) 110 WRITE(charout, FMT="('BIO')") 111 CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 113 ENDIF 114 115 !! tracers: sedimentation model 116 !! ---------------------------- 117 118 CALL trcsed(kt) 119 IF(ln_ctl) THEN ! print mean trends (used for debugging) 120 WRITE(charout, FMT="('SED')") 121 CALL prt_ctl_trc_info(charout) 122 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 123 ENDIF 124 125 CALL trcexp(kt) 126 127 IF(ln_ctl) THEN ! print mean trends (used for debugging) 128 WRITE(charout, FMT="('EXP')") 129 CALL prt_ctl_trc_info(charout) 130 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 131 ENDIF 132 133 #elif defined key_trc_pisces 134 135 !! p4zprg: main PROGRAM for PISCES 136 !! ------------------------------- 137 CALL p4zprg(kt) 138 139 !! SMS to DO 140 141 #elif defined key_cfc 142 143 !! CFC's code taken from K. Rodgers 144 145 !! This part is still experimental 146 !! ------------------------------- 147 148 CALL trc_freons(kt) 149 150 #endif 151 152 153 61 ! 154 62 END SUBROUTINE trc_sms 155 63 156 64 #else 157 65 !!====================================================================== 158 !! Empty module :No passive tracer66 !! Dummy module : No passive tracer 159 67 !!====================================================================== 160 68 CONTAINS 161 162 SUBROUTINE trc_sms( kt ) 163 164 ! no passive tracers 69 SUBROUTINE trc_sms( kt ) ! Empty routine 165 70 INTEGER, INTENT( in ) :: kt 166 71 WRITE(*,*) 'trc_sms: You should not have seen this print! error?', kt 167 72 END SUBROUTINE trc_sms 168 169 73 #endif 170 74 171 75 !!====================================================================== 172 76 END MODULE trcsms
Note: See TracChangeset
for help on using the changeset viewer.