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 NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/SBC – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/SBC/sbcflx.F90 @ 11844

Last change on this file since 11844 was 11671, checked in by acc, 5 years ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.

  • Property svn:keywords set to Id
File size: 9.2 KB
Line 
1MODULE sbcflx
2   !!======================================================================
3   !!                       ***  MODULE  sbcflx  ***
4   !! Ocean forcing:  momentum, heat and freshwater flux formulation
5   !!=====================================================================
6   !! History :  1.0  !  2006-06  (G. Madec)  Original code
7   !!            3.3  !  2010-10  (S. Masson)  add diurnal cycle
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   namflx   : flux formulation namlist
12   !!   sbc_flx  : flux formulation as ocean surface boundary condition (forced mode, fluxes read in NetCDF files)
13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
16   USE sbc_oce         ! surface boundary condition: ocean fields
17   USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr
18   USE phycst          ! physical constants
19   !
20   USE fldread         ! read input fields
21   USE iom             ! IOM library
22   USE in_out_manager  ! I/O manager
23   USE lib_mpp         ! distribued memory computing library
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25
26   IMPLICIT NONE
27   PRIVATE
28
29   PUBLIC sbc_flx       ! routine called by step.F90
30
31   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read
32   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
33   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
34   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
35   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
36   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
37   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
38
39   !! * Substitutions
40#  include "vectopt_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
43   !! $Id$
44   !! Software governed by the CeCILL license (see ./LICENSE)
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 (i,j) mesh referential
64      !!
65      !! ** Action  :   update at each time-step
66      !!              - utau, vtau  i- and j-component of the wind stress
67      !!              - taum        wind stress module at T-point
68      !!              - wndm        10m wind module at T-point
69      !!              - qns         non solar heat flux including heat flux due to emp
70      !!              - qsr         solar heat flux
71      !!              - emp         upward mass flux (evap. - precip.)
72      !!              - sfx         salt flux; set to zero at nit000 but possibly non-zero
73      !!                            if ice is present
74      !!----------------------------------------------------------------------
75      INTEGER, INTENT(in) ::   kt   ! ocean time step
76      !!
77      INTEGER  ::   ji, jj, jf            ! dummy indices
78      INTEGER  ::   ierror                ! return error code
79      INTEGER  ::   ios                   ! Local integer output status for namelist read
80      REAL(wp) ::   zfact                 ! temporary scalar
81      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
82      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
83      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
84      !!
85      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
86      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
87      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
88      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
89      !!---------------------------------------------------------------------
90      !
91      IF( kt == nit000 ) THEN                ! First call kt=nit000 
92         ! set file information
93         READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901)
94901      IF( ios /= 0 )   CALL ctl_nam ( ios , 'namsbc_flx in reference namelist' )
95
96         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 )
97902      IF( ios >  0 )   CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' )
98         IF(lwm) WRITE ( numond, namsbc_flx ) 
99         !
100         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
101         IF( ln_dm2dc .AND. sn_qsr%freqh /= 24. )   &
102            &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
103         !
104         !                                         ! store namelist information in an array
105         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
106         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
107         slf_i(jp_emp ) = sn_emp
108         !
109         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
110         IF( ierror > 0 ) THEN   
111            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN 
112         ENDIF
113         DO ji= 1, jpfld
114            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
115            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
116         END DO
117         !                                         ! fill sf with slf_i and control print
118         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
119         !
120         sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present)
121         !
122      ENDIF
123
124      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step
125     
126      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
127
128         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
129         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
130         ENDIF
131         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
132            DO ji = 1, jpi
133               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
134               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
135               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
136               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
137            END DO
138         END DO
139         !                                                        ! add to qns the heat due to e-p
140         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST
141         !
142         qns(:,:) = qns(:,:) * tmask(:,:,1)
143         emp(:,:) = emp(:,:) * tmask(:,:,1)
144         !
145         !                                                        ! module of wind stress and wind speed at T-point
146         zcoef = 1. / ( zrhoa * zcdrag )
147         DO jj = 2, jpjm1
148            DO ji = fs_2, fs_jpim1   ! vect. opt.
149               ztx = utau(ji-1,jj  ) + utau(ji,jj) 
150               zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
151               zmod = 0.5 * SQRT( ztx * ztx + zty * zty )
152               taum(ji,jj) = zmod
153               wndm(ji,jj) = SQRT( zmod * zcoef )
154            END DO
155         END DO
156         taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1)
157         CALL lbc_lnk( 'sbcflx', taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( 'sbcflx', wndm(:,:), 'T', 1. )
158
159         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked)
160            WRITE(numout,*) 
161            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
162            DO jf = 1, jpfld
163               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
164               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
165               IF( jf == jp_emp                     )   zfact = 86400.
166               WRITE(numout,*) 
167               WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact
168            END DO
169         ENDIF
170         !
171      ENDIF
172      !
173   END SUBROUTINE sbc_flx
174
175   !!======================================================================
176END MODULE sbcflx
Note: See TracBrowser for help on using the repository browser.