Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 (modified) (6 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
- Property svn:eol-style deleted
r1601 r2528 2 2 !!============================================================================== 3 3 !! *** MODULE trabbc *** 4 !! Ocean active tracers: bottom boundary condition 4 !! Ocean active tracers: bottom boundary condition (geothermal heat flux) 5 5 !!============================================================================== 6 !! History : 8.1 ! 99-10 (G. Madec) original code 7 !! 8.5 ! 02-08 (G. Madec) free form + modules 8 !! 8.5 ! 02-11 (A. Bozec) tra_bbc_init: original code 6 !! History : OPA ! 1999-10 (G. Madec) original code 7 !! NEMO 1.0 ! 2002-08 (G. Madec) free form + modules 8 !! - ! 2002-11 (A. Bozec) tra_bbc_init: original code 9 !! 3.3 ! 2010-10 (G. Madec) dynamical allocation + suppression of key_trabbc 10 !! - ! 2010-11 (G. Madec) use mbkt array (deepest ocean t-level) 9 11 !!---------------------------------------------------------------------- 10 #if defined key_trabbc || defined key_esopa 11 !!---------------------------------------------------------------------- 12 !! 'key_trabbc' geothermal heat flux 12 13 13 !!---------------------------------------------------------------------- 14 14 !! tra_bbc : update the tracer trend at ocean bottom 15 15 !! tra_bbc_init : initialization of geothermal heat flux trend 16 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and active tracers18 USE dom_oce ! ocean space and time domain17 USE oce ! ocean variables 18 USE dom_oce ! domain: ocean 19 19 USE phycst ! physical constants 20 USE trdmod ! ocean trends21 USE trd mod_oce ! ocean variables trends20 USE trdmod_oce ! trends: ocean variables 21 USE trdtra ! trends: active tracers 22 22 USE in_out_manager ! I/O manager 23 23 USE prtctl ! Print control … … 27 27 28 28 PUBLIC tra_bbc ! routine called by step.F90 29 PUBLIC tra_bbc_init ! routine called by opa.F90 29 30 30 !! to be transfert in the namelist ???! 31 LOGICAL, PUBLIC, PARAMETER :: lk_trabbc = .TRUE. !: bbc flag 31 ! !!* Namelist nambbc: bottom boundary condition * 32 LOGICAL, PUBLIC :: ln_trabbc = .FALSE. !: Geothermal heat flux flag 33 INTEGER :: nn_geoflx = 1 ! Geothermal flux (=1:constant flux, =2:read in file ) 34 REAL(wp) :: rn_geoflx_cst = 86.4e-3_wp ! Constant value of geothermal heat flux 32 35 33 ! !!* Namelist nambbc: bottom boundary condition * 34 INTEGER :: nn_geoflx = 1 ! Geothermal flux (0:no flux, 1:constant flux, 2:read in file ) 35 REAL(wp) :: rn_geoflx_cst = 86.4e-3 ! Constant value of geothermal heat flux 36 37 INTEGER , DIMENSION(jpi,jpj) :: nbotlevt ! ocean bottom level index at T-pt 38 REAL(wp), DIMENSION(jpi,jpj) :: qgh_trd0 ! geothermal heating trend 36 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd0 ! geothermal heating trend 39 37 40 38 !! * Substitutions 41 39 # include "domzgr_substitute.h90" 42 40 !!---------------------------------------------------------------------- 43 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)44 !! $Id $45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)41 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 42 !! $Id $ 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 44 !!---------------------------------------------------------------------- 47 48 45 CONTAINS 49 46 … … 61 58 !! ocean bottom can be computed once and is added to the temperature 62 59 !! trend juste above the bottom at each time step: 63 !! ta = ta + Qsf / (rau0 rcp e3T) for k= mb athy -160 !! ta = ta + Qsf / (rau0 rcp e3T) for k= mbkt 64 61 !! Where Qsf is the geothermal heat flux. 65 62 !! … … 70 67 !! Emile-Geay and Madec, 2009, Ocean Science. 71 68 !!---------------------------------------------------------------------- 72 USE oce, ONLY : ztrdt => ua ! use ua as 3D workspace73 USE oce, ONLY : ztrds => va ! use va as 3D workspace74 !!75 69 INTEGER, INTENT( in ) :: kt ! ocean time-step index 76 70 !! 77 INTEGER :: ji, jj ! dummy loop indices 78 REAL(wp) :: zqgh_trd ! geothermal heat flux trend 71 INTEGER :: ji, jj, ik ! dummy loop indices 72 REAL(wp) :: zqgh_trd ! geothermal heat flux trend 73 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt 79 74 !!---------------------------------------------------------------------- 80 81 IF( kt == nit000 ) CALL tra_bbc_init ! Initialization 82 75 ! 83 76 IF( l_trdtra ) THEN ! Save ta and sa trends 84 ztrdt(:,:,:) = ta(:,:,:) 85 ztrds(:,:,:) = 0.e0 86 ENDIF 87 88 ! Add the geothermal heat flux trend on temperature 89 90 SELECT CASE ( nn_geoflx ) 91 ! 92 CASE ( 1:2 ) ! geothermal heat flux 93 #if defined key_vectopt_loop 94 DO jj = 1, 1 95 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 96 #else 97 DO jj = 2, jpjm1 98 DO ji = 2, jpim1 99 #endif 100 zqgh_trd = ro0cpr * qgh_trd0(ji,jj) / fse3t(ji,jj,nbotlevt(ji,jj)) 101 ta(ji,jj,nbotlevt(ji,jj)) = ta(ji,jj,nbotlevt(ji,jj)) + zqgh_trd 102 END DO 103 END DO 104 END SELECT 105 106 IF( l_trdtra ) THEN ! Save the geothermal heat flux trend for diagnostics 107 ztrdt(:,:,:) = ta(:,:,:) - ztrdt(:,:,:) 108 CALL trd_mod( ztrdt, ztrds, jptra_trd_bbc, 'TRA', kt ) 77 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 109 78 ENDIF 110 79 ! 111 IF(ln_ctl) CALL prt_ctl( tab3d_1=ta, clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 80 ! ! Add the geothermal heat flux trend on temperature 81 #if defined key_vectopt_loop 82 DO jj = 1, 1 83 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 84 #else 85 DO jj = 2, jpjm1 86 DO ji = 2, jpim1 87 #endif 88 ik = mbkt(ji,jj) 89 zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) 90 tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 91 END DO 92 END DO 93 ! 94 IF( l_trdtra ) THEN ! Save the geothermal heat flux trend for diagnostics 95 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 96 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt ) 97 DEALLOCATE( ztrdt ) 98 ENDIF 99 ! 100 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbc - Ta: ', mask1=tmask, clinfo3='tra-ta' ) 112 101 ! 113 102 END SUBROUTINE tra_bbc … … 128 117 !! 129 118 !! ** Action : - read/fix the geothermal heat qgh_trd0 130 !! - compute the bottom ocean level nbotlevt131 119 !!---------------------------------------------------------------------- 132 120 USE iom … … 135 123 INTEGER :: inum ! temporary logical unit 136 124 !! 137 NAMELIST/nambbc/ nn_geoflx, rn_geoflx_cst125 NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 138 126 !!---------------------------------------------------------------------- 139 127 140 REWIND ( numnam )! Read Namelist nambbc : bottom momentum boundary condition141 READ 128 REWIND( numnam ) ! Read Namelist nambbc : bottom momentum boundary condition 129 READ ( numnam, nambbc ) 142 130 143 IF(lwp) THEN ! Control print131 IF(lwp) THEN ! Control print 144 132 WRITE(numout,*) 145 WRITE(numout,*) 'tra_bbc : temperature Bottom Boundary Condition (bbc), Geothermal heatflux'133 WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating' 146 134 WRITE(numout,*) '~~~~~~~ ' 147 135 WRITE(numout,*) ' Namelist nambbc : set bbc parameters' 148 WRITE(numout,*) ' Geothermal flux nn_geoflx = ', nn_geoflx 149 WRITE(numout,*) ' Constant geothermal flux rn_geoflx_cst = ', rn_geoflx_cst 136 WRITE(numout,*) ' Apply a geothermal heating at ocean bottom ln_trabbc = ', ln_trabbc 137 WRITE(numout,*) ' type of geothermal flux nn_geoflx = ', nn_geoflx 138 WRITE(numout,*) ' Constant geothermal flux value rn_geoflx_cst = ', rn_geoflx_cst 150 139 WRITE(numout,*) 151 140 ENDIF 152 141 153 ! ! level of the ocean bottom at T-point 154 DO jj = 1, jpj 155 DO ji = 1, jpi 156 nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 ) 157 END DO 158 END DO 159 160 SELECT CASE ( nn_geoflx ) ! initialization of geothermal heat flux 161 ! 162 CASE ( 0 ) ! no geothermal heat flux 142 IF( ln_trabbc ) THEN !== geothermal heating ==! 143 ! 144 ALLOCATE( qgh_trd0(jpi,jpj) ) ! allocation 145 ! 146 SELECT CASE ( nn_geoflx ) ! geothermal heat flux / (rauO * Cp) 147 ! 148 CASE ( 1 ) !* constant flux 149 IF(lwp) WRITE(numout,*) ' *** constant heat flux = ', rn_geoflx_cst 150 qgh_trd0(:,:) = ro0cpr * rn_geoflx_cst 151 ! 152 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 153 IF(lwp) WRITE(numout,*) ' *** variable geothermal heat flux' 154 CALL iom_open ( 'geothermal_heating.nc', inum ) 155 CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 156 CALL iom_close( inum ) 157 qgh_trd0(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2 158 ! 159 CASE DEFAULT 160 WRITE(ctmp1,*) ' bad flag value for nn_geoflx = ', nn_geoflx 161 CALL ctl_stop( ctmp1 ) 162 ! 163 END SELECT 164 ! 165 ELSE 163 166 IF(lwp) WRITE(numout,*) ' *** no geothermal heat flux' 164 ! 165 CASE ( 1 ) ! constant flux 166 IF(lwp) WRITE(numout,*) ' *** constant heat flux = ', rn_geoflx_cst 167 ! 168 qgh_trd0(:,:) = rn_geoflx_cst 169 ! 170 CASE ( 2 ) ! variable geothermal heat flux : read the geothermal fluxes in mW/m2 171 IF(lwp) WRITE(numout,*) ' *** variable geothermal heat flux' 172 CALL iom_open ( 'geothermal_heating.nc', inum ) 173 CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 174 CALL iom_close( inum ) 175 ! 176 qgh_trd0(:,:) = qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2 177 ! 178 CASE DEFAULT 179 WRITE(ctmp1,*) ' bad flag value for nn_geoflx = ', nn_geoflx 180 CALL ctl_stop( ctmp1 ) 181 ! 182 END SELECT 167 ENDIF 183 168 ! 184 169 END SUBROUTINE tra_bbc_init 185 170 186 #else187 !!----------------------------------------------------------------------188 !! Default option Empty module189 !!----------------------------------------------------------------------190 LOGICAL, PUBLIC, PARAMETER :: lk_trabbc = .FALSE. !: bbc flag191 CONTAINS192 SUBROUTINE tra_bbc( kt ) ! Empty routine193 WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt194 END SUBROUTINE tra_bbc195 #endif196 197 171 !!====================================================================== 198 172 END MODULE trabbc
Note: See TracChangeset
for help on using the changeset viewer.
