Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r4624 r5965 18 18 USE dom_oce ! domain: ocean 19 19 USE phycst ! physical constants 20 USE trd mod_oce ! trends: ocean variables21 USE trdtra ! trends : activetracers20 USE trd_oce ! trends: ocean variables 21 USE trdtra ! trends manager: tracers 22 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 23 27 USE prtctl ! Print control 24 28 USE wrk_nemo ! Memory Allocation … … 37 41 38 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) 39 44 40 45 !! * Substitutions … … 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 !!---------------------------------------------------------------------- … … 84 89 ! 85 90 ! ! Add the geothermal heat flux trend on temperature 86 #if defined key_vectopt_loop87 DO jj = 1, 188 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)89 #else90 91 DO jj = 2, jpjm1 91 92 DO ji = 2, jpim1 92 #endif93 93 ik = mbkt(ji,jj) 94 94 zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik) … … 97 97 END DO 98 98 ! 99 CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. ) 100 ! 99 101 IF( l_trdtra ) THEN ! Save the geothermal heat flux trend for diagnostics 100 102 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 101 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ trd_bbc, ztrdt )103 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 102 104 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt ) 103 105 ENDIF … … 130 132 INTEGER :: inum ! temporary logical unit 131 133 INTEGER :: ios ! Local integer output status for namelist read 132 !! 133 NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 134 INTEGER :: ierror ! local integer 135 ! 136 TYPE(FLD_N) :: sn_qgh ! informations about the geotherm. field to be read 137 CHARACTER(len=256) :: cn_dir ! Root directory for location of ssr files 138 ! 139 NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 134 140 !!---------------------------------------------------------------------- 135 141 … … 166 172 CASE ( 2 ) !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 167 173 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 174 ! 175 ALLOCATE( sf_qgh(1), STAT=ierror ) 176 IF( ierror > 0 ) THEN 177 CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' ) ; 178 RETURN 179 ENDIF 180 ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1) ) 181 IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) ) 182 ! fill sf_chl with sn_chl and control print 183 CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init', & 184 & 'bottom temperature boundary condition', 'nambbc' ) 185 186 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data 187 qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2 172 188 ! 173 189 CASE DEFAULT
Note: See TracChangeset
for help on using the changeset viewer.