New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
sbcflx.F90 in branches/dev_r2174_DCY/NEMO/OPA_SRC/SBC – NEMO

source: branches/dev_r2174_DCY/NEMO/OPA_SRC/SBC/sbcflx.F90 @ 2216

Last change on this file since 2216 was 2216, checked in by smasson, 14 years ago

diurnal cycle in coupled mode in dev_r2174_DCY, see ticket:730

  • Property svn:keywords set to Id
File size: 9.5 KB
RevLine 
[888]1MODULE sbcflx
2   !!======================================================================
3   !!                       ***  MODULE  sbcflx  ***
4   !! Ocean forcing:  momentum, heat and freshwater flux formulation
5   !!=====================================================================
[2188]6   !! History :  1.0  !  2006-06  (G. Madec)  Original code
7   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
[888]8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   namflx   : flux formulation namlist
[2188]12   !!   sbc_flx  : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files)
[888]13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
[2188]16   USE sbc_oce         ! surface boundary condition: ocean fields
17   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr
[888]18   USE phycst          ! physical constants
19   USE fldread         ! read input fields
20   USE iom             ! IOM library
21   USE in_out_manager  ! I/O manager
22   USE lib_mpp         ! distribued memory computing library
23   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC sbc_flx       ! routine called by step.F90
29
30   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read
31   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
32   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
33   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
34   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
35   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
36   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
37
38   !! * Substitutions
39#  include "domzgr_substitute.h90"
[1029]40#  include "vectopt_loop_substitute.h90"
[888]41   !!----------------------------------------------------------------------
[2188]42   !! NEMO/OPA 3.3 , NEMO-consortium (2010)
[1156]43   !! $Id$
[888]44   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE sbc_flx( kt )
49      !!---------------------------------------------------------------------
50      !!                    ***  ROUTINE sbc_flx  ***
51      !!                   
52      !! ** Purpose :   provide at each time step the surface ocean fluxes
53      !!                (momentum, heat, freshwater and runoff)
54      !!
55      !! ** Method  : - READ each fluxes in NetCDF files:
56      !!                   i-component of the stress              utau  (N/m2)
57      !!                   j-component of the stress              vtau  (N/m2)
58      !!                   net downward heat flux                 qtot  (watt/m2)
59      !!                   net downward radiative flux            qsr   (watt/m2)
60      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s)
61      !!
62      !!      CAUTION :  - never mask the surface stress fields
63      !!                 - the stress is assumed to be in the mesh referential
64      !!                   i.e. the (i,j) referential
65      !!
66      !! ** Action  :   update at each time-step
[1695]67      !!              - utau, vtau  i- and j-component of the wind stress
68      !!              - taum        wind stress module at T-point
69      !!              - wndm        10m wind module at T-point
70      !!              - qns, qsr    non-slor and solar heat flux
71      !!              - emp, emps   evaporation minus precipitation
[888]72      !!----------------------------------------------------------------------
73      INTEGER, INTENT(in) ::   kt   ! ocean time step
74      !!
[1695]75      INTEGER  ::   ji, jj, jf            ! dummy indices
76      INTEGER  ::   ierror                ! return error code
77      REAL(wp) ::   zfact                 ! temporary scalar
78      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
79      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
80      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
[888]81      !!
82      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
83      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
84      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
85      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
86      !!---------------------------------------------------------------------
[2188]87      !
88      IF( kt == nit000 ) THEN                ! First call kt=nit000 
[888]89         ! set file information
90         cn_dir = './'        ! directory in which the model is executed
91         ! ... default values (NB: frequency positive => hours, negative => months)
[2188]92         !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
93         !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     !
94         sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
95         sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
96         sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
97         sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
98         sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
99         !
100         REWIND ( numnam )                         ! read in namlist namflx
[888]101         READ   ( numnam, namsbc_flx ) 
[2188]102         !
103         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
[2187]104         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &
105            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
[2188]106         !
107         !                                         ! store namelist information in an array
[888]108         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
109         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
110         slf_i(jp_emp ) = sn_emp
[2188]111         !
112         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
[1133]113         IF( ierror > 0 ) THEN   
114            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
[888]115         ENDIF
[1200]116         DO ji= 1, jpfld
[2188]117            ALLOCATE( sf(ji)%fnow(jpi,jpj)   )
[1200]118            ALLOCATE( sf(ji)%fdta(jpi,jpj,2) )
119         END DO
[2188]120         !                                         ! fill sf with slf_i and control print
[1133]121         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
[888]122         !
123      ENDIF
124
[2210]125      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step
126     
127      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
[2216]128         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow )   ! modify now Qsr to include the diurnal cycle
[2210]129         ELSE                  ;   qsr(:,:) = sf(jp_qsr)%fnow(:,:)
130         ENDIF
[888]131!CDIR COLLAPSE
[2188]132         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
[1274]133            DO ji = 1, jpi
134               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
135               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
[2210]136               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - qsr(ji,jj)
[1274]137               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj)
138            END DO
[888]139         END DO
[2188]140         !                                                        ! module of wind stress and wind speed at T-point
141         zcoef = 1. / ( zrhoa * zcdrag )
[1695]142!CDIR NOVERRCHK
143         DO jj = 2, jpjm1
144!CDIR NOVERRCHK
145            DO ji = fs_2, fs_jpim1   ! vect. opt.
146               ztx = utau(ji-1,jj  ) + utau(ji,jj) 
147               zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
148               zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
149               taum(ji,jj) = zmod
150               wndm(ji,jj) = SQRT( zmod * zcoef )
151            END DO
152         END DO
153         CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. )
154
[2188]155         emps(:,:) = emp (:,:)                                    ! Initialization of emps (needed when no ice model)
[1695]156                 
[2188]157         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked)
[888]158            WRITE(numout,*) 
[1274]159            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
160            DO jf = 1, jpfld
161               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
162               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
163               IF( jf == jp_emp                     )   zfact = 86400.
164               WRITE(numout,*) 
165               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
166               CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout )
167            END DO
168            CALL FLUSH(numout)
169         ENDIF
170         !
[888]171      ENDIF
172      !
173   END SUBROUTINE sbc_flx
174
175   !!======================================================================
176END MODULE sbcflx
Note: See TracBrowser for help on using the repository browser.