Changeset 5837 for branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

Timestamp:

2015-10-26T15:59:39+01:00 (9 years ago)

Author:

timgraham

Message:

Upgraded to r5518 of trunk (NEMO 3.6 stable)

File:

• branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90 (modified) (7 diffs)

branches/2014/dev_r4650_UKMO14.4_OBS_GENERAL_VINTERP/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

@@ -18 +18 @@
    USE dom_oce         ! domain: ocean
    USE phycst          ! physical constants
-   USE trdmod_oce      ! trends: ocean variables 
-   USE trdtra          ! trends: active tracers 
+   USE trd_oce         ! trends: ocean variables
+   USE trdtra          ! trends manager: tracers 
    USE in_out_manager  ! I/O manager
+   USE iom             ! I/O manager
+   USE fldread         ! read input fields
+   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
+   USE lib_mpp           ! distributed memory computing library
    USE prtctl          ! Print control
    USE wrk_nemo        ! Memory Allocation
@@ -37 +41 @@
 
    REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_qgh              ! structure of input qgh (file informations, fields read)
  
    !! * Substitutions
@@ -42 +47 @@
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
-   !! $Id $ 
+   !! $Id$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -84 +89 @@
       !
       !                             !  Add the geothermal heat flux trend on temperature
-#if defined key_vectopt_loop
-      DO jj = 1, 1
-         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling)
-#else
       DO jj = 2, jpjm1
          DO ji = 2, jpim1
-#endif
             ik = mbkt(ji,jj)
             zqgh_trd = qgh_trd0(ji,jj) / fse3t(ji,jj,ik)
@@ -97 +97 @@
       END DO
       !
+      CALL lbc_lnk( tsa(:,:,:,jp_tem) , 'T', 1. )
+      !
       IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics
          ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)
-         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt )
+         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt )
          CALL wrk_dealloc( jpi, jpj, jpk, ztrdt )
       ENDIF
@@ -130 +132 @@
       INTEGER  ::   inum                ! temporary logical unit
       INTEGER  ::   ios                 ! Local integer output status for namelist read
-      !!
-      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst 
+      INTEGER  ::   ierror              ! local integer
+      !
+      TYPE(FLD_N)        ::   sn_qgh    ! informations about the geotherm. field to be read
+      CHARACTER(len=256) ::   cn_dir    ! Root directory for location of ssr files
+      !
+      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst, sn_qgh, cn_dir 
       !!----------------------------------------------------------------------
 
@@ -166 +172 @@
          CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2
             IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux'
-            CALL iom_open ( 'geothermal_heating.nc', inum )
-            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 )
-            CALL iom_close( inum )
-            qgh_trd0(:,:) = r1_rau0_rcp * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2
+            !
+            ALLOCATE( sf_qgh(1), STAT=ierror )
+            IF( ierror > 0 ) THEN
+               CALL ctl_stop( 'tra_bbc_init: unable to allocate sf_qgh structure' )   ;
+               RETURN
+            ENDIF
+            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   )
+            IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) )
+            ! fill sf_chl with sn_chl and control print
+            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   &
+               &          'bottom temperature boundary condition', 'nambbc' )
+
+            CALL fld_read( nit000, 1, sf_qgh )                         ! Read qgh data
+            qgh_trd0(:,:) = r1_rau0_rcp * sf_qgh(1)%fnow(:,:,1) * 1.e-3 ! conversion in W/m2
             !
          CASE DEFAULT