Changeset 2325


Ignore:
Timestamp:
2010-10-28T10:58:09+02:00 (10 years ago)
Author:
cetlod
Message:

Improvment of trabbc.F90 routine ( by gm ) : dynamical allocation + suppression of key_trabbc

Location:
branches/nemo_v3_3_beta/NEMOGCM
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r2317 r2325  
    337337!!====================================================================== 
    338338!!   nambfr        bottom friction 
    339 !!   nambbc        bottom temperature boundary condition                ("key_trabbc") 
     339!!   nambbc        bottom temperature boundary condition                 
    340340!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    341341!!====================================================================== 
     
    355355&nambbc        !   bottom temperature boundary condition 
    356356!----------------------------------------------------------------------- 
     357   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    357358   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux  
    358359                           !     = 1 constant flux 
  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist

    r2317 r2325  
    337337!!====================================================================== 
    338338!!   nambfr        bottom friction 
    339 !!   nambbc        bottom temperature boundary condition                ("key_trabbc") 
     339!!   nambbc        bottom temperature boundary condition                
    340340!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    341341!!====================================================================== 
     
    355355&nambbc        !   bottom temperature boundary condition 
    356356!----------------------------------------------------------------------- 
     357   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    357358   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux  
    358359                           !     = 1 constant flux 
  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist

    r2317 r2325  
    201201   ln_qsr_2bd  = .false.   !  2 bands              light penetration 
    202202   ln_qsr_bio  = .false.   !  bio-model light penetration 
    203    nn_chldta   =      0    !  RGB : Chl data (=1) or cst value (=0) 
     203   nn_chldta   =      1    !  RGB : Chl data (=1) or cst value (=0) 
    204204   rn_abs      =   0.58    !  RGB & 2 bands: fraction of light (rn_si1) 
    205205   rn_si0      =   0.35    !  RGB & 2 bands: shortess depth of extinction 
     
    348348!!====================================================================== 
    349349!!   nambfr        bottom friction 
    350 !!   nambbc        bottom temperature boundary condition                ("key_trabbc") 
     350!!   nambbc        bottom temperature boundary condition                 
    351351!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    352352!!====================================================================== 
     
    366366&nambbc        !   bottom temperature boundary condition 
    367367!----------------------------------------------------------------------- 
     368   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    368369   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux  
    369370                           !     = 1 constant flux 
  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r2317 r2325  
    381381!!====================================================================== 
    382382!!   nambfr        bottom friction 
    383 !!   nambbc        bottom temperature boundary condition                ("key_trabbc") 
     383!!   nambbc        bottom temperature boundary condition                
    384384!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    385385!!====================================================================== 
     
    399399&nambbc        !   bottom temperature boundary condition 
    400400!----------------------------------------------------------------------- 
     401   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    401402   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux  
    402403                           !     = 1 constant flux 
  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist

    r2317 r2325  
    381381!!====================================================================== 
    382382!!   nambfr        bottom friction 
    383 !!   nambbc        bottom temperature boundary condition                ("key_trabbc") 
     383!!   nambbc        bottom temperature boundary condition                
    384384!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    385385!!====================================================================== 
     
    399399&nambbc        !   bottom temperature boundary condition 
    400400!----------------------------------------------------------------------- 
     401   ln_trabbc   = .true.    !  Apply a geothermal heating at the ocean bottom 
    401402   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux  
    402403                           !     = 1 constant flux 
  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r2317 r2325  
    381381!!====================================================================== 
    382382!!   nambfr        bottom friction 
    383 !!   nambbc        bottom temperature boundary condition                ("key_trabbc") 
     383!!   nambbc        bottom temperature boundary condition               
    384384!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    385385!!====================================================================== 
     
    399399&nambbc        !   bottom temperature boundary condition 
    400400!----------------------------------------------------------------------- 
     401   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    401402   nn_geoflx   =    2      !  geothermal heat flux: = 0 no flux  
    402403                           !     = 1 constant flux 
  • branches/nemo_v3_3_beta/NEMOGCM/CONFIG/POMME/EXP00/namelist

    r2317 r2325  
    382382!!====================================================================== 
    383383!!   nambfr        bottom friction 
    384 !!   nambbc        bottom temperature boundary condition                ("key_trabbc") 
    385 !!   nambbl        bottom boundary layer scheme                         ("key_trabbl_dif","key_trabbl_adv") 
     384!!   nambbc        bottom temperature boundary condition                 
     385!!   nambbl        bottom boundary layer scheme                         ("key_trabbl") 
    386386!!====================================================================== 
    387387 
     
    398398&nambbc        !   bottom temperature boundary condition 
    399399!----------------------------------------------------------------------- 
     400   ln_trabbc   = .false.   !  Apply a geothermal heating at the ocean bottom 
    400401   nn_geoflx   =    0      !  geothermal heat flux: = 0 no flux  
    401402                           !     = 1 constant flux 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r2287 r2325  
    22   !!============================================================================== 
    33   !!                       ***  MODULE  trabbc  *** 
    4    !! Ocean active tracers:  bottom boundary condition 
     4   !! Ocean active tracers:  bottom boundary condition (geothermal heat flux) 
    55   !!============================================================================== 
    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 
    910   !!---------------------------------------------------------------------- 
    10 #if   defined key_trabbc   ||   defined key_esopa 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_trabbc'                                  geothermal heat flux 
    13    !!---------------------------------------------------------------------- 
     11 
    1412   !!   tra_bbc      : update the tracer trend at ocean bottom  
    1513   !!   tra_bbc_init : initialization of geothermal heat flux trend 
     
    2927   PUBLIC tra_bbc_init     ! routine called by opa.F90 
    3028 
    31    !! to be transfert in the namelist ???!    
    32    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .TRUE.   !: bbc flag 
     29   !                                                !!* Namelist nambbc: bottom boundary condition * 
     30   LOGICAL, PUBLIC ::   ln_trabbc     = .FALSE.      !: Geothermal heat flux flag 
     31   INTEGER         ::   nn_geoflx     = 1            !  Geothermal flux (=1:constant flux, =2:read in file ) 
     32   REAL(wp)        ::   rn_geoflx_cst = 86.4e-3_wp   !  Constant value of geothermal heat flux 
    3333 
    34    !                                         !!* Namelist nambbc: bottom boundary condition * 
    35    INTEGER  ::   nn_geoflx     = 1            ! Geothermal flux (0:no flux, 1:constant flux, 2:read in file ) 
    36    REAL(wp) ::   rn_geoflx_cst = 86.4e-3      ! Constant value of geothermal heat flux 
    37  
    38    INTEGER , DIMENSION(jpi,jpj)         ::   nbotlevt   ! ocean bottom level index at T-pt 
    39    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   qgh_trd0   ! geothermal heating trend 
     34   INTEGER , DIMENSION(:,:), ALLOCATABLE ::   nbotlevt   ! ocean bottom level index at T-pt 
     35   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   qgh_trd0   ! geothermal heating trend 
    4036  
    4137   !! * Substitutions 
     
    4339   !!---------------------------------------------------------------------- 
    4440   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    45    !! $Id$  
    46    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     41   !! $Id $  
     42   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4743   !!---------------------------------------------------------------------- 
    48  
    4944CONTAINS 
    5045 
     
    7671      INTEGER  ::   ji, jj, ik    ! dummy loop indices 
    7772      REAL(wp) ::   zqgh_trd  ! geothermal heat flux trend 
    78       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt, ztrds 
     73      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrdt 
    7974      !!---------------------------------------------------------------------- 
    8075 
    8176      IF( l_trdtra )   THEN         ! Save ta and sa trends 
    8277         ALLOCATE( ztrdt(jpi,jpj,jpk) )     ;   ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    83          ALLOCATE( ztrds(jpi,jpj,jpk) )     ;   ztrds(:,:,:) = 0. 
    8478      ENDIF 
    8579 
    86       ! Add the geothermal heat flux trend on temperature 
    87  
    88       SELECT CASE ( nn_geoflx ) 
    89       ! 
    90       CASE ( 1:2 )                !  geothermal heat flux 
     80      !                             !  Add the geothermal heat flux trend on temperature 
    9181#if defined key_vectopt_loop 
    92          DO jj = 1, 1 
    93             DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
     82      DO jj = 1, 1 
     83         DO ji = jpi+2, jpij-jpi-1   ! vector opt. (forced unrolling) 
    9484#else 
    95          DO jj = 2, jpjm1 
    96             DO ji = 2, jpim1 
     85      DO jj = 2, jpjm1 
     86         DO ji = 2, jpim1 
    9787#endif 
    98                ik = nbotlevt(ji,jj) 
    99                zqgh_trd = ro0cpr * qgh_trd0(ji,jj) / fse3t(ji,jj,ik) 
    100                tsa(ji,jj,ik,jp_tem) = tsa(ji,jj,ik,jp_tem) + zqgh_trd 
    101             END DO 
     88            ik = nbotlevt(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 
    10291         END DO 
    103       END SELECT 
     92      END DO 
    10493 
    10594      IF( l_trdtra ) THEN        ! Save the geothermal heat flux trend for diagnostics 
    10695         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    10796         CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_bbc, ztrdt ) 
    108          CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_bbc, ztrds ) 
    109          DEALLOCATE( ztrdt )   ;     DEALLOCATE( ztrds ) 
     97         DEALLOCATE( ztrdt ) 
    11098      ENDIF 
    11199      ! 
     
    136124      INTEGER  ::   inum                ! temporary logical unit 
    137125      !! 
    138       NAMELIST/nambbc/nn_geoflx, rn_geoflx_cst  
     126      NAMELIST/nambbc/ln_trabbc, nn_geoflx, rn_geoflx_cst  
    139127      !!---------------------------------------------------------------------- 
    140128 
     
    142130      READ   ( numnam, nambbc ) 
    143131 
    144       IF(lwp) THEN                   ! Control print 
     132      IF(lwp) THEN                     ! Control print 
    145133         WRITE(numout,*) 
    146          WRITE(numout,*) 'tra_bbc : temperature Bottom Boundary Condition (bbc), Geothermal heatflux' 
     134         WRITE(numout,*) 'tra_bbc : Bottom Boundary Condition (bbc), apply a Geothermal heating' 
    147135         WRITE(numout,*) '~~~~~~~   ' 
    148136         WRITE(numout,*) '   Namelist nambbc : set bbc parameters' 
    149          WRITE(numout,*) '      Geothermal flux            nn_geoflx     = ', nn_geoflx 
    150          WRITE(numout,*) '      Constant geothermal flux   rn_geoflx_cst = ', rn_geoflx_cst 
     137         WRITE(numout,*) '      Apply a geothermal heating at ocean bottom   ln_trabbc     = ', ln_trabbc 
     138         WRITE(numout,*) '      type of geothermal flux                      nn_geoflx     = ', nn_geoflx 
     139         WRITE(numout,*) '      Constant geothermal flux value               rn_geoflx_cst = ', rn_geoflx_cst 
    151140         WRITE(numout,*) 
    152141      ENDIF 
    153142 
    154       !                              ! level of the ocean bottom at T-point 
    155       DO jj = 1, jpj 
    156          DO ji = 1, jpi 
    157             nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 ) 
     143      IF( ln_trabbc ) THEN             !==  geothermal heating  ==! 
     144         ! 
     145         ALLOCATE( nbotlevt(jpi,jpj) )    ! allocation 
     146         ALLOCATE( qgh_trd0(jpi,jpj) )      
     147         !              
     148         DO jj = 1, jpj                   ! level of the ocean bottom at T-point 
     149            DO ji = 1, jpi 
     150               nbotlevt(ji,jj) = MAX( mbathy(ji,jj)-1, 1 ) 
     151            END DO 
    158152         END DO 
    159       END DO 
    160  
    161       SELECT CASE ( nn_geoflx )      ! initialization of geothermal heat flux 
    162       ! 
    163       CASE ( 0 )                ! no geothermal heat flux 
    164          IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux' 
    165153         ! 
    166       CASE ( 1 )                ! constant flux 
    167          IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst 
     154         SELECT CASE ( nn_geoflx )        ! geothermal heat flux / (rauO * Cp) 
    168155         ! 
    169          qgh_trd0(:,:) = rn_geoflx_cst 
     156         CASE ( 1 )                          !* constant flux 
     157            IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst 
     158            qgh_trd0(:,:) = ro0cpr * rn_geoflx_cst 
     159            ! 
     160         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
     161            IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux' 
     162            CALL iom_open ( 'geothermal_heating.nc', inum ) 
     163            CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 
     164            CALL iom_close( inum ) 
     165            qgh_trd0(:,:) = ro0cpr * qgh_trd0(:,:) * 1.e-3     ! conversion in W/m2 
     166            ! 
     167         CASE DEFAULT 
     168            WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx 
     169            CALL ctl_stop( ctmp1 ) 
     170            ! 
     171         END SELECT 
    170172         ! 
    171       CASE ( 2 )                ! variable geothermal heat flux : read the geothermal fluxes in mW/m2 
    172          IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux' 
    173          CALL iom_open ( 'geothermal_heating.nc', inum ) 
    174          CALL iom_get  ( inum, jpdom_data, 'heatflow', qgh_trd0 ) 
    175          CALL iom_close( inum ) 
    176          ! 
    177          qgh_trd0(:,:) = qgh_trd0(:,:) * 1.e-3 ! conversion in W/m2 
    178          ! 
    179       CASE DEFAULT 
    180          WRITE(ctmp1,*) '     bad flag value for nn_geoflx = ', nn_geoflx 
    181          CALL ctl_stop( ctmp1 ) 
    182          ! 
    183       END SELECT 
     173      ELSE 
     174            IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux' 
     175      ENDIF 
    184176      ! 
    185177   END SUBROUTINE tra_bbc_init 
    186178 
    187 #else 
    188    !!---------------------------------------------------------------------- 
    189    !!   Default option                                         Empty module 
    190    !!---------------------------------------------------------------------- 
    191    LOGICAL, PUBLIC, PARAMETER ::   lk_trabbc = .FALSE.  !: bbc flag 
    192 CONTAINS 
    193    SUBROUTINE tra_bbc( kt )           ! Empty routine 
    194       WRITE(*,*) 'tra_bbc: You should not have seen this print! error?', kt 
    195    END SUBROUTINE tra_bbc 
    196    SUBROUTINE tra_bbc_init           ! Empty routine 
    197    END SUBROUTINE tra_bbc_init 
    198 #endif 
    199  
    200179   !!====================================================================== 
    201180END MODULE trabbc 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/opa.F90

    r2303 r2325  
    288288      !                                     ! Active tracers 
    289289                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
    290       IF( lk_trabbc     )   CALL tra_bbc_init   ! bottom heat flux 
     290                            CALL tra_bbc_init   ! bottom heat flux 
    291291      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    292292      IF( lk_tradmp     )   CALL tra_dmp_init   ! internal damping trends 
  • branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/step.F90

    r2305 r2325  
    191191                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
    192192      IF( ln_traqsr      )   CALL tra_qsr    ( kstp )       ! penetrative solar radiation qsr 
    193       IF( lk_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
     193      IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    194194      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    195195      IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
Note: See TracChangeset for help on using the changeset viewer.