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 10251 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90 – NEMO

Ignore:
Timestamp:
2018-10-29T15:20:26+01:00 (5 years ago)
Author:
kingr
Message:

Rolled back to r10247 - i.e., undid merge of pkg br and 3.6_stable br

File:
1 edited

Legend:

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

    r10249 r10251  
    2222   USE lib_mpp         ! distribued memory computing library 
    2323   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    24    USE wrk_nemo        ! work arrays 
    2524 
    2625   IMPLICIT NONE 
     
    2928   PUBLIC sbc_flx       ! routine called by step.F90 
    3029 
    31    INTEGER , PARAMETER ::   jpfld   = 6   ! maximum number of files to read  
     30   INTEGER , PARAMETER ::   jpfld   = 5   ! maximum number of files to read  
    3231   INTEGER , PARAMETER ::   jp_utau = 1   ! index of wind stress (i-component) file 
    3332   INTEGER , PARAMETER ::   jp_vtau = 2   ! index of wind stress (j-component) file 
     
    3534   INTEGER , PARAMETER ::   jp_qsr  = 4   ! index of solar heat file 
    3635   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
    37    INTEGER , PARAMETER ::   jp_press = 6  ! index of pressure for UKMO shelf fluxes 
    3836   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    39    LOGICAL , PUBLIC    ::   ln_shelf_flx = .FALSE. ! UKMO SHELF specific flux flag 
    40    LOGICAL , PUBLIC    ::   ln_rel_wind = .FALSE.  ! UKMO SHELF specific flux flag - relative winds 
    41    REAL(wp)            ::   rn_wfac                ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem) 
    42    INTEGER             ::   jpfld_local   ! maximum number of files to read (locally modified depending on ln_shelf_flx)  
    4337 
    4438   !! * Substitutions 
     
    8882      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    8983      REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
    90       REAL     ::   cs                    ! UKMO SHELF: Friction co-efficient at surface 
    91       REAL     ::   totwindspd            ! UKMO SHELF: Magnitude of wind speed vector 
    92       REAL(wp), DIMENSION(:,:), POINTER ::   zwnd_i, zwnd_j    ! wind speed components at T-point 
    93  
    94       REAL(wp) ::   rhoa  = 1.22         ! Air density kg/m3 
    95       REAL(wp) ::   cdrag = 1.5e-3       ! drag coefficient  
    9684      !! 
    9785      CHARACTER(len=100) ::  cn_dir                               ! Root directory for location of flx files 
    9886      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    99       TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, sn_press  !  informations about the fields to be read  
    100       LOGICAL     ::   ln_foam_flx  = .FALSE.                     ! UKMO FOAM specific flux flag  
    101       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp,   &  
    102       &                    ln_foam_flx, sn_press, ln_shelf_flx, ln_rel_wind,    & 
    103       &                    rn_wfac 
     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 
    10489      !!--------------------------------------------------------------------- 
    10590      ! 
     
    124109         slf_i(jp_emp ) = sn_emp 
    125110         ! 
    126             ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    127             IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 
    128     
    129             ! define local jpfld depending on shelf_flx logical 
    130             IF( ln_shelf_flx ) THEN 
    131                jpfld_local = jpfld 
    132             ELSE 
    133                jpfld_local = jpfld-1 
    134             ENDIF 
    135             ! 
     111         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    136112         IF( ierror > 0 ) THEN    
    137113            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
    138114         ENDIF 
    139          DO ji= 1, jpfld_local 
     115         DO ji= 1, jpfld 
    140116            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 
    141117            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 
     
    152128      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    153129 
    154          !!UKMO SHELF wind speed relative to surface currents - put here to allow merging with coupling branch 
    155          IF( ln_shelf_flx ) THEN 
    156             CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j ) 
    157  
    158             IF( ln_rel_wind ) THEN 
    159                DO jj = 1, jpj 
    160                   DO ji = 1, jpi 
    161                      zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) - rn_wfac * ssu_m(ji,jj) 
    162                      zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) - rn_wfac * ssv_m(ji,jj) 
    163                   END DO 
    164                END DO 
    165             ELSE 
    166                zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1) 
    167                zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1) 
    168             ENDIF 
    169          ENDIF 
    170  
    171130         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle 
    172131         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1) 
    173132         ENDIF 
    174133!CDIR COLLAPSE 
    175             !!UKMO SHELF effect of atmospheric pressure on SSH 
    176             ! If using ln_apr_dyn, this is done there so don't repeat here. 
    177             IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 
    178                DO jj = 1, jpjm1 
    179                   DO ji = 1, jpim1 
    180                      apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 
    181                      apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 
    182                   END DO 
    183                END DO 
    184             ENDIF ! ln_shelf_flx 
    185  
    186134         DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    187135            DO ji = 1, jpi 
    188                    IF( ln_shelf_flx ) THEN 
    189                       !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 
    190                       pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 
    191                       !! UKMO SHELF flux files contain wind speed not wind stress 
    192                       totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 
    193                       cs = 0.63 + (0.066 * totwindspd) 
    194                       utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd 
    195                       vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd 
    196                    ELSE 
    197                       utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    198                       vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    199                    ENDIF 
    200                    qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
    201                    IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 
    202                       !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 
    203                       qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 
    204                       !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 
    205                       emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 
    206                    ELSE 
    207                       qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    208                       emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
    209                    ENDIF 
     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) 
    210140            END DO 
    211141         END DO 
     
    213143         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    214144         ! 
    215     
    216             !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 
    217             IF( ln_foam_flx ) THEN 
    218                CALL lbc_lnk( utau(:,:), 'U', -1. ) 
    219                CALL lbc_lnk( vtau(:,:), 'V', -1. ) 
    220             ENDIF 
    221      
    222145         !                                                        ! module of wind stress and wind speed at T-point 
    223146         zcoef = 1. / ( zrhoa * zcdrag ) 
     
    239162            WRITE(numout,*)  
    240163            WRITE(numout,*) '        read daily momentum, heat and freshwater fluxes OK' 
    241             DO jf = 1, jpfld_local 
     164            DO jf = 1, jpfld 
    242165               IF( jf == jp_utau .OR. jf == jp_vtau )   zfact =     1. 
    243166               IF( jf == jp_qtot .OR. jf == jp_qsr  )   zfact =     0.1 
     
    250173         ENDIF 
    251174         ! 
    252          IF( ln_shelf_flx ) THEN 
    253             CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j ) 
    254          ENDIF 
    255          ! 
    256175      ENDIF 
    257176      ! 
Note: See TracChangeset for help on using the changeset viewer.