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 trunk/NEMO/OPA_SRC/SBC – NEMO

source: trunk/NEMO/OPA_SRC/SBC/sbcflx.F90 @ 1146

Last change on this file since 1146 was 1146, checked in by rblod, 16 years ago

Add svn Id (first try), see ticket #210

  • Property svn:keywords set to Id
File size: 9.4 KB
Line 
1MODULE sbcflx
2   !!======================================================================
3   !!                       ***  MODULE  sbcflx  ***
4   !! Ocean forcing:  momentum, heat and freshwater flux formulation
5   !!=====================================================================
6   !! History :  9.0   !  06-06  (G. Madec)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   namflx   : flux formulation namlist
11   !!   sbc_flx  : flux formulation as ocean surface boundary condition
12   !!              (forced mode, fluxes read in NetCDF files)
13   !!----------------------------------------------------------------------
14   !! question diverses
15   !!  *   ajouter un test sur la division entier de freqh et rdttra ???
16   !!  **  ajoute dans namelist: 1 year forcing files
17   !!                         or forcing file starts at the begining of the run
18   !!  *** we assume that the forcing file start and end with the previous
19   !!      year last record and the next year first record (useful for
20   !!      time interpolation, required even if no time interp???)
21   !!  *   ajouter un test sur la division de la frequence en pas de temps
22   !!  ==> daymod ajout de nsec_year = number of second since the begining of the year
23   !!      assumed to be 0 at 0h january the 1st (i.e. 24h december the 31)
24   !!
25   !!  *** regrouper dtatem et dtasal
26   !!----------------------------------------------------------------------
27   USE oce             ! ocean dynamics and tracers
28   USE dom_oce         ! ocean space and time domain
29   USE sbc_oce         ! Surface boundary condition: ocean fields
30   USE phycst          ! physical constants
31   USE daymod          ! calendar
32   USE fldread         ! read input fields
33   USE iom             ! IOM library
34   USE in_out_manager  ! I/O manager
35   USE lib_mpp         ! distribued memory computing library
36   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
37
38   IMPLICIT NONE
39   PRIVATE
40
41   PUBLIC sbc_flx       ! routine called by step.F90
42
43   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read
44   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
45   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
46   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
47   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
48   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
49   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
50
51   REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3
52   REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient
53
54   !! * Substitutions
55#  include "domzgr_substitute.h90"
56#  include "vectopt_loop_substitute.h90"
57   !!----------------------------------------------------------------------
58   !!   OPA 9.0 , LOCEAN-IPSL (2006)
59   !! $ Id: $
60   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
61   !!----------------------------------------------------------------------
62
63CONTAINS
64
65   SUBROUTINE sbc_flx( kt )
66      !!---------------------------------------------------------------------
67      !!                    ***  ROUTINE sbc_flx  ***
68      !!                   
69      !! ** Purpose :   provide at each time step the surface ocean fluxes
70      !!                (momentum, heat, freshwater and runoff)
71      !!
72      !! ** Method  : - READ each fluxes in NetCDF files:
73      !!                   i-component of the stress              utau  (N/m2)
74      !!                   j-component of the stress              vtau  (N/m2)
75      !!                   net downward heat flux                 qtot  (watt/m2)
76      !!                   net downward radiative flux            qsr   (watt/m2)
77      !!                   net upward freshwater (evapo - precip) emp   (kg/m2/s)
78      !!                Assumptions made:
79      !!                 - each file content an entire year (read record, not the time axis)
80      !!                 - first and last record are part of the previous and next year
81      !!                   (useful for time interpolation)
82      !!                 - the number of records is 2 + 365*24 / freqh(jf)
83      !!                   or 366 in leap year case
84      !!
85      !!      CAUTION :  - never mask the surface stress fields
86      !!                 - the stress is assumed to be in the mesh referential
87      !!                   i.e. the (i,j) referential
88      !!
89      !! ** Action  :   update at each time-step
90      !!              - utau  & vtau    : stress components in (i,j) referential
91      !!              - qns             : non solar heat flux
92      !!              - qsr             : solar heat flux
93      !!              - emp             : evap - precip (volume flux)
94      !!              - emps            : evap - precip (concentration/dillution)
95      !!----------------------------------------------------------------------
96      INTEGER, INTENT(in) ::   kt   ! ocean time step
97      !!
98      INTEGER  ::   ji, jj, jf   ! dummy indices
99      INTEGER  ::   ierror       ! return error code
100      REAL(wp) ::   zfact        ! temporary scalar
101      REAL(wp) ::   ztx, zty, ztau, zcoef
102      !!
103      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
104      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
105      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
106      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
107      !!---------------------------------------------------------------------
108      !                                         ! ====================== !
109      IF( kt == nit000 ) THEN                   !  First call kt=nit000  !
110         !                                      ! ====================== !
111         ! set file information
112         cn_dir = './'        ! directory in which the model is executed
113         ! ... default values (NB: frequency positive => hours, negative => months)
114         !              !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or !
115         !              !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  !
116         sn_utau = FLD_N(   'utau'  ,    24.    ,  'utau'    ,  .false.   , .false. ,   'yearly'  )
117         sn_vtau = FLD_N(   'vtau'  ,    24.    ,  'vtau'    ,  .false.   , .false. ,   'yearly'  )
118         sn_qtot = FLD_N(   'qtot'  ,    24.    ,  'qtot'    ,  .false.   , .false. ,   'yearly'  )
119         sn_qsr  = FLD_N(   'qsr'   ,    24.    ,  'qsr'     ,  .false.   , .false. ,   'yearly'  )
120         sn_emp  = FLD_N(   'emp'   ,    24.    ,  'emp'     ,  .false.   , .false. ,   'yearly'  )
121
122         REWIND ( numnam )               ! ... read in namlist namflx
123         READ   ( numnam, namsbc_flx ) 
124
125         ! store namelist information in an array
126         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
127         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
128         slf_i(jp_emp ) = sn_emp
129
130         ! set sf structure
131         ALLOCATE( sf(jpfld), STAT=ierror )
132         IF( ierror > 0 ) THEN   
133            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
134         ENDIF
135
136         ! fill sf with slf_i and control print
137         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
138         !
139      ENDIF
140
141      CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the
142      !                                          ! input fields at the current time-step
143
144      ! set the ocean fluxes from read fields
145!CDIR COLLAPSE
146      DO jj = 1, jpj
147         DO ji = 1, jpi
148            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj)
149            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj)
150            qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj)
151            qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj)
152            emp (ji,jj) = sf(jp_emp )%fnow(ji,jj)
153         END DO
154      END DO
155
156      ! Estimation of wind speed as a function of wind stress ( |tau|=rhoa*Cd*|U|^2 )
157      zcoef = 0.5 / ( rhoa * cdrag ) 
158!CDIR NOVERRCHK
159      DO jj = 2, jpjm1
160!CDIR NOVERRCHK
161         DO ji = fs_2, fs_jpim1   ! vect. opt.
162            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
163            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
164            ztau = SQRT( ztx * ztx + zty * zty )
165            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
166         END DO
167      END DO
168      CALL lbc_lnk( wndm(:,:) , 'T', 1. )
169
170      ! control print (if less than 100 time-step asked)
171      IF( nitend-nit000 <= 100 .AND. lwp ) THEN
172         WRITE(numout,*) 
173         WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
174         DO jf = 1, jpfld
175            IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
176            IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
177            IF( jf == jp_emp                     )   zfact = 86400.
178            WRITE(numout,*) 
179            WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
180            CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout )
181         END DO
182         CALL FLUSH(numout)
183      ENDIF
184      !
185   END SUBROUTINE sbc_flx
186
187   !!======================================================================
188END MODULE sbcflx
Note: See TracBrowser for help on using the repository browser.