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.
Changeset 5428 for branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90 – NEMO

Ignore:
Timestamp:
2015-06-16T06:25:15+02:00 (9 years ago)
Author:
deazer
Message:

Added incode changes to allow compoarisoin with CO5 after svn keywords removed.
Extracts, merges builds and runs as expected from working copy.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r5418 r5428  
    2828   PUBLIC sbc_flx       ! routine called by step.F90 
    2929 
    30    INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read  
     30   INTEGER , PARAMETER ::   jpfld   = 6   ! maximum number of files to read  
    3131   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file 
    3232   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file 
     
    3434   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file 
    3535   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
     36   INTEGER , PARAMETER ::   jp_press = 6  ! index of pressure for UKMO shelf fluxes 
    3637   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
     38   LOGICAL , PUBLIC    ::   ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag 
     39   INTEGER             ::   jpfld_local   ! maximum number of files to read (locally modified depending on ln_shelf_flx)  
    3740 
    3841   !! * Substitutions 
     
    8285      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    8386      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
     87      REAL     ::   cs                    ! UKMO SHELF: Friction co-efficient at surface 
     88      REAL     ::   totwindspd            ! UKMO SHELF: Magnitude of wind speed vector 
     89    
     90      REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3 
     91      REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient  
    8492      !! 
    8593      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    8694      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 
     95      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press  !  informations about the fields to be read 
     96      LOGICAL     ::   ln_foam_flx  = .FALSE.                     ! UKMO FOAM specific flux flag 
     97      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp,   & 
     98      &                    ln_foam_flx, sn_press, ln_shelf_flx 
    8999      !!--------------------------------------------------------------------- 
    90100      ! 
     
    109119         slf_i(jp_emp ) = sn_emp 
    110120         ! 
    111          ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
     121         IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 
     122 
     123         ! define local jpfld depending on shelf_flx logical 
     124         IF( ln_shelf_flx ) THEN 
     125            jpfld_local = jpfld 
     126         ELSE 
     127            jpfld_local = jpfld-1 
     128         ENDIF 
     129         ! 
     130         ALLOCATE( sf(jpfld_local), STAT=ierror )        ! set sf structure 
    112131         IF( ierror > 0 ) THEN    
    113132            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
     
    132151         ENDIF 
    133152!CDIR COLLAPSE 
     153            !!UKMO SHELF effect of atmospheric pressure on SSH 
     154            ! If using ln_apr_dyn, this is done there so don't repeat here. 
     155            IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 
     156               DO jj = 1, jpjm1 
     157                  DO ji = 1, jpim1 
     158                     apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 
     159                     apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 
     160                  END DO 
     161               END DO 
     162            ENDIF ! ln_shelf_flx 
    134163         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    135164            DO ji = 1, jpi 
    136                utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    137                vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    138                qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    139                emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     165                IF( ln_shelf_flx ) THEN 
     166                   !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 
     167                   pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 
     168                   !! UKMO SHELF flux files contain wind speed not wind stress 
     169                   totwindspd = sqrt((sf(jp_utau)%fnow(ji,jj,1))**2.0 + (sf(jp_vtau)%fnow(ji,jj,1))**2.0) 
     170                   cs = 0.63 + (0.066 * totwindspd) 
     171                   utau(ji,jj) = cs * (rhoa/rau0) * sf(jp_utau)%fnow(ji,jj,1) * totwindspd 
     172                   vtau(ji,jj) = cs * (rhoa/rau0) * sf(jp_vtau)%fnow(ji,jj,1) * totwindspd 
     173                ELSE 
     174                   utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     175                   vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     176                ENDIF 
     177                qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
     178                IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 
     179                   !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 
     180                   qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 
     181                   !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 
     182                   emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 
     183                ELSE 
     184                   qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
     185                   emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     186                ENDIF 
    140187            END DO 
    141188         END DO 
     
    143190         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    144191         ! 
     192 
     193         !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 
     194         IF( ln_foam_flx ) THEN 
     195            CALL lbc_lnk( utau(:,:), 'U', -1. ) 
     196            CALL lbc_lnk( vtau(:,:), 'V', -1. ) 
     197         ENDIF 
     198     
    145199         !                                                        ! module of wind stress and wind speed at T-point 
    146200         zcoef = 1. / ( zrhoa * zcdrag ) 
     
    162216            WRITE(numout,*)  
    163217            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    164             DO jf = 1, jpfld 
     218            DO jf = 1, jpfld_local 
    165219               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1. 
    166220               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 
Note: See TracChangeset for help on using the changeset viewer.