- Timestamp:
- 2016-01-08T10:35:19+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r4624 r6225 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 trdmod_oce ! trends: ocean variables 21 USE trdtra ! trends: active tracers 22 USE in_out_manager ! I/O manager 23 USE prtctl ! Print control 24 USE wrk_nemo ! Memory Allocation 25 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 26 31 27 32 IMPLICIT NONE … … 36 41 REAL(wp) :: rn_geoflx_cst ! Constant value of geothermal heat flux 37 42 38 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: qgh_trd0 ! geothermal heating trend 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) 39 46 40 !! * Substitutions41 # include "domzgr_substitute.h90"42 47 !!---------------------------------------------------------------------- 43 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 44 !! $Id $49 !! $Id$ 45 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 51 !!---------------------------------------------------------------------- … … 63 68 !! Where Qsf is the geothermal heat flux. 64 69 !! 65 !! ** Action : - update the temperature trends (ta) with the trend of66 !! the ocean bottom boundary condition70 !! ** Action : - update the temperature trends with geothermal heating trend 71 !! - send the trend for further diagnostics (ln_trdtra=T) 67 72 !! 68 73 !! References : Stein, C. A., and S. Stein, 1992, Nature, 359, 123-129. … … 70 75 !!---------------------------------------------------------------------- 71 76 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 !! 73 INTEGER :: ji, jj, ik ! dummy loop indices 74 REAL(wp) :: zqgh_trd ! geothermal heat flux trend 77 ! 78 INTEGER :: ji, jj ! dummy loop indices 75 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt 76 80 !!---------------------------------------------------------------------- … … 78 82 IF( nn_timing == 1 ) CALL timing_start('tra_bbc') 79 83 ! 80 IF( l_trdtra ) THEN ! Save t a and sa trends81 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 ) 82 86 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 83 87 ENDIF 84 ! 85 ! ! Add the geothermal heat flux trend on temperature 86 #if defined key_vectopt_loop 87 DO jj = 1, 1 88 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 89 #else 88 ! ! Add the geothermal trend on temperature 90 89 DO jj = 2, jpjm1 91 90 DO ji = 2, jpim1 92 #endif 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 98 94 ! 99 IF( l_trdtra ) THEN ! Save the geothermal heat flux trend for diagnostics 95 CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. ) 96 ! 97 IF( l_trdtra ) THEN ! Send the trend for diagnostics 100 98 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 101 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_bbc, ztrdt )102 CALL wrk_dealloc( jpi, jpj, jpk,ztrdt )99 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 100 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt ) 103 101 ENDIF 104 102 ! … … 125 123 !! ** Action : - read/fix the geothermal heat qgh_trd0 126 124 !!---------------------------------------------------------------------- 127 USE iom128 !!129 125 INTEGER :: ji, jj ! dummy loop indices 130 126 INTEGER :: inum ! temporary logical unit 131 127 INTEGER :: ios ! Local integer output status for namelist read 132 !! 133 NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 128 INTEGER :: ierror ! local integer 129 ! 130 TYPE(FLD_N) :: sn_qgh ! informations about the geotherm. field to be read 131 CHARACTER(len=256) :: cn_dir ! Root directory for location of ssr files 132 ! 133 NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 134 134 !!---------------------------------------------------------------------- 135 135 ! 136 136 REWIND( numnam_ref ) ! Namelist nambbc in reference namelist : Bottom momentum boundary condition 137 137 READ ( numnam_ref, nambbc, IOSTAT = ios, ERR = 901) 138 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp )139 138 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbc in reference namelist', lwp ) 139 ! 140 140 REWIND( numnam_cfg ) ! Namelist nambbc in configuration namelist : Bottom momentum boundary condition 141 141 READ ( numnam_cfg, nambbc, IOSTAT = ios, ERR = 902 ) 142 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 ) 143 143 IF(lwm) WRITE ( numond, nambbc ) 144 144 ! 145 145 IF(lwp) THEN ! Control print 146 146 WRITE(numout,*) … … 153 153 WRITE(numout,*) 154 154 ENDIF 155 155 ! 156 156 IF( ln_trabbc ) THEN !== geothermal heating ==! 157 157 ! … … 166 166 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 167 167 IF(lwp) WRITE(numout,*) ' *** variable geothermal heat flux' 168 CALL iom_open ( 'geothermal_heating.nc', inum ) 169 CALL iom_get ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 170 CALL iom_close( inum ) 171 qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2 168 ! 169 ALLOCATE( sf_qgh(1), STAT=ierror ) 170 IF( ierror > 0 ) THEN 171 CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' ) ; 172 RETURN 173 ENDIF 174 ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1) ) 175 IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) ) 176 ! fill sf_chl with sn_chl and control print 177 CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init', & 178 & 'bottom temperature boundary condition', 'nambbc' ) 179 180 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data 181 qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 172 182 ! 173 183 CASE DEFAULT 174 184 WRITE(ctmp1,*) ' bad flag value for nn_geoflx = ', nn_geoflx 175 185 CALL ctl_stop( ctmp1 ) 176 !177 186 END SELECT 178 187 !
Note: See TracChangeset
for help on using the changeset viewer.
