- Timestamp:
- 2016-11-28T17:04:10+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r5397 r7351 12 12 13 13 !!---------------------------------------------------------------------- 14 !! tra_bbc : update the tracer trend at ocean bottom15 !! tra_bbc_init : initialization of geothermal heat flux trend14 !! tra_bbc : update the tracer trend at ocean bottom 15 !! tra_bbc_init : initialization of geothermal heat flux trend 16 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean variables 18 USE dom_oce ! domain: ocean 19 USE phycst ! physical constants 20 USE trd_oce ! trends: ocean variables 21 USE trdtra ! trends manager: tracers 22 USE in_out_manager ! I/O manager 23 USE iom ! I/O manager 24 USE fldread ! read input fields 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE lib_mpp ! distributed memory computing library 27 USE prtctl ! Print control 28 USE wrk_nemo ! Memory Allocation 29 USE timing ! Timing 17 USE oce ! ocean variables 18 USE dom_oce ! domain: ocean 19 USE phycst ! physical constants 20 USE trd_oce ! trends: ocean variables 21 USE trdtra ! trends manager: tracers 22 ! 23 USE in_out_manager ! I/O manager 24 USE iom ! xIOS 25 USE fldread ! read input fields 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE lib_mpp ! distributed memory computing library 28 USE prtctl ! Print control 29 USE wrk_nemo ! Memory Allocation 30 USE timing ! Timing 30 31 31 32 IMPLICIT NONE … … 40 41 REAL(wp) :: rn_geoflx_cst ! Constant value of geothermal heat flux 41 42 42 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd0 ! geothermal heating trend 43 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_qgh ! structure of input qgh (file informations, fields read) 43 REAL(wp), PUBLIC , ALLOCATABLE, DIMENSION(:,:) :: qgh_trd0 ! geothermal heating trend 44 45 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_qgh ! structure of input qgh (file informations, fields read) 44 46 45 !! * Substitutions46 # include "domzgr_substitute.h90"47 47 !!---------------------------------------------------------------------- 48 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 68 68 !! Where Qsf is the geothermal heat flux. 69 69 !! 70 !! ** Action : - update the temperature trends (ta) with the trend of71 !! the ocean bottom boundary condition70 !! ** Action : - update the temperature trends with geothermal heating trend 71 !! - send the trend for further diagnostics (ln_trdtra=T) 72 72 !! 73 73 !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. … … 75 75 !!---------------------------------------------------------------------- 76 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 !! 78 INTEGER :: ji, jj, ik ! dummy loop indices 79 REAL(wp) :: zqgh_trd ! geothermal heat flux trend 77 ! 78 INTEGER :: ji, jj ! dummy loop indices 80 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt 81 80 !!---------------------------------------------------------------------- … … 83 82 IF( nn_timing == 1 ) CALL timing_start('tra_bbc') 84 83 ! 85 IF( l_trdtra ) THEN ! Save t a and sa trends86 CALL wrk_alloc( jpi, jpj, jpk,ztrdt )84 IF( l_trdtra ) THEN ! Save the input temperature trend 85 CALL wrk_alloc( jpi,jpj,jpk, ztrdt ) 87 86 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 88 87 ENDIF 89 ! 90 ! ! Add the geothermal heat flux trend on temperature 88 ! ! Add the geothermal trend on temperature 91 89 DO jj = 2, jpjm1 92 90 DO ji = 2, jpim1 93 ik = mbkt(ji,jj) 94 zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) 95 tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 91 tsa(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj)) 96 92 END DO 97 93 END DO … … 99 95 CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. ) 100 96 ! 101 IF( l_trdtra ) THEN ! S ave the geothermal heat fluxtrend for diagnostics97 IF( l_trdtra ) THEN ! Send the trend for diagnostics 102 98 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 103 99 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 104 CALL wrk_dealloc( jpi, jpj, jpk,ztrdt )100 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) 105 101 ENDIF 106 102 ! … … 127 123 !! ** Action : - read/fix the geothermal heat qgh_trd0 128 124 !!---------------------------------------------------------------------- 129 USE iom130 !!131 125 INTEGER :: ji, jj ! dummy loop indices 132 126 INTEGER :: inum ! temporary logical unit … … 139 133 NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 140 134 !!---------------------------------------------------------------------- 141 135 ! 142 136 REWIND( numnam_ref ) ! Namelist nambbc in reference namelist : Bottom momentum boundary condition 143 137 READ ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901) 144 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )145 138 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp ) 139 ! 146 140 REWIND( numnam_cfg ) ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition 147 141 READ ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 ) 148 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp )142 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in configuration namelist', lwp ) 149 143 IF(lwm) WRITE ( numond, nambbc ) 150 144 ! 151 145 IF(lwp) THEN ! Control print 152 146 WRITE(numout,*) … … 159 153 WRITE(numout,*) 160 154 ENDIF 161 155 ! 162 156 IF( ln_trabbc ) THEN !== geothermal heating ==! 163 157 ! … … 190 184 WRITE(ctmp1,*) ' bad flag value for nn_geoflx = ', nn_geoflx 191 185 CALL ctl_stop( ctmp1 ) 192 !193 186 END SELECT 194 187 !
Note: See TracChangeset
for help on using the changeset viewer.