Changeset 4827 for branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

Timestamp:

2014-10-31T12:45:41+01:00 (9 years ago)

Author:

charris

Message:

Some demonstration code changes.

File:

• branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90 (modified) (6 diffs)

branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

@@ -17 +17 @@
    USE sbcdcy          ! surface boundary condition: diurnal cycle on qsr
    USE phycst          ! physical constants
-   USE fldread         ! read input fields
+   USE fldread2        ! read input fields
+   USE fld_def
+   USE sbcget
    USE iom             ! IOM library
    USE in_out_manager  ! I/O manager
@@ -27 +29 @@
 
    PUBLIC sbc_flx       ! routine called by step.F90
-
-   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read 
-   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file
-   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file
-   INTEGER , PARAMETER ::   jp_qtot = 3   ! index of total (non solar+solar) heat file
-   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file
-   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file
-   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read)
 
    !! * Substitutions
@@ -76 +70 @@
       !!
       INTEGER  ::   ji, jj, jf            ! dummy indices
-      INTEGER  ::   ierror                ! return error code
       REAL(wp) ::   zfact                 ! temporary scalar
       REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
@@ -82 +75 @@
       REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables
       !!
-      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
-      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures
-      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read
-      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
+!      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files
+!      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp
       !!---------------------------------------------------------------------
       !
       IF( kt == nit000 ) THEN                ! First call kt=nit000  
-         ! set file information
-         cn_dir = './'        ! directory in which the model is executed
-         ! ... default values (NB: frequency positive => hours, negative => months)
-         !              !  file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation  !
-         !              !  name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs     !
-         sn_utau = FLD_N(  'utau' ,    24     ,  'utau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
-         sn_vtau = FLD_N(  'vtau' ,    24     ,  'vtau'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
-         sn_qtot = FLD_N(  'qtot' ,    24     ,  'qtot'    ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
-         sn_qsr  = FLD_N(  'qsr'  ,    24     ,  'qsr'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
-         sn_emp  = FLD_N(  'emp'  ,    24     ,  'emp'     ,  .false.   , .false. ,   'yearly'  , ''       , ''        )
-         !
-         REWIND ( numnam )                         ! read in namlist namflx
-         READ   ( numnam, namsbc_flx ) 
          !
          !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing?
-         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &
+         IF( ln_dm2dc .AND. sf(jp_qsroce)%nfreqh /= 24 )   &
             &   CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 
-         !
-         !                                         ! store namelist information in an array
-         slf_i(jp_utau) = sn_utau   ;   slf_i(jp_vtau) = sn_vtau
-         slf_i(jp_qtot) = sn_qtot   ;   slf_i(jp_qsr ) = sn_qsr 
-         slf_i(jp_emp ) = sn_emp
-         !
-         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure
-         IF( ierror > 0 ) THEN   
-            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN  
-         ENDIF
-         DO ji= 1, jpfld
-            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) )
-            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) )
-         END DO
-         !                                         ! fill sf with slf_i and control print
-         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' )
          !
          sfx(:,:) = 0.0_wp                         ! salt flux due to freezing/melting (non-zero only if ice is present; set in limsbc(_2).F90)
@@ -127 +89 @@
       ENDIF
 
-      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step
-     
       IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency
 
-         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
-         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1)
+         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsroce)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle
+         ELSE                  ;   qsr(:,:) =          sf(jp_qsroce)%fnow(:,:,1)
          ENDIF
 !CDIR COLLAPSE
          DO jj = 1, jpj                                           ! set the ocean fluxes from read fields
             DO ji = 1, jpi
-               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1)
-               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1)
-               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1)
-               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1)
+               utau(ji,jj) = sf(jp_otx1)%fnow(ji,jj,1)
+               vtau(ji,jj) = sf(jp_oty1)%fnow(ji,jj,1)
+               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsroce)%fnow(ji,jj,1)
+               emp (ji,jj) = sf(jp_oemp )%fnow(ji,jj,1)
             END DO
          END DO
@@ -165 +125 @@
             WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK'
             DO jf = 1, jpfld
-               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1.
-               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1
-               IF( jf == jp_emp                     )   zfact = 86400.
+               IF( jf == jp_otx1 .OR. jf == jp_oty1   )   zfact =     1.
+               IF( jf == jp_qtot .OR. jf == jp_qsroce )   zfact =     0.1
+               IF( jf == jp_oemp                       )   zfact = 86400.
                WRITE(numout,*) 
                WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact