Changeset 12599


Ignore:
Timestamp:
2020-03-25T10:46:53+01:00 (7 months ago)
Author:
jcastill
Message:

Merge changes relative to Met Office utils ticket 334 - wind velocity calculation for direct forcing and reorganization of ln_shelf_flx code

File:
1 edited

Legend:

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

    r11277 r12599  
    135135         slf_i(jp_emp ) = sn_emp 
    136136         ! 
    137             ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
    138             IF( ln_shelf_flx ) slf_i(jp_press) = sn_press 
    139     
    140             ! define local jpfld depending on shelf_flx logical 
    141             IF( ln_shelf_flx ) THEN 
    142                jpfld_local = jpfld 
    143             ELSE 
    144                jpfld_local = jpfld-1 
    145             ENDIF 
    146             ! 
     137         ! define local jpfld depending on shelf_flx logical 
     138         IF( ln_shelf_flx ) THEN 
     139            slf_i(jp_press) = sn_press 
     140            jpfld_local = jpfld 
     141         ELSE 
     142            jpfld_local = jpfld-1 
     143         ENDIF 
     144         ! 
     145         ALLOCATE( sf(jpfld), STAT=ierror )        ! set sf structure 
     146         ! 
    147147         IF( ierror > 0 ) THEN    
    148148            CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' )   ;   RETURN   
     
    163163      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    164164 
     165         IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle 
     166         ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1) 
     167         ENDIF 
     168 
    165169         !!UKMO SHELF wind speed relative to surface currents - put here to allow merging with coupling branch 
    166170         IF( ln_shelf_flx ) THEN 
    167171            CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j ) 
    168172 
    169             IF( ln_rel_wind ) THEN 
    170                DO jj = 1, jpj 
    171                   DO ji = 1, jpi 
     173            ! set the ocean fluxes from read fields 
     174            DO jj = 1, jpj 
     175               DO ji = 1, jpi 
     176                  !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 
     177                  pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 
     178                  !! UKMO SHELF flux files contain wind speed not wind stress 
     179                  IF( ln_rel_wind ) THEN 
    172180                     zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) - rn_wfac * ssu_m(ji,jj) 
    173181                     zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) - rn_wfac * ssv_m(ji,jj) 
    174                   END DO 
    175                END DO 
    176             ELSE 
    177                zwnd_i(:,:) = sf(jp_utau)%fnow(:,:,1) 
    178                zwnd_j(:,:) = sf(jp_vtau)%fnow(:,:,1) 
    179             ENDIF 
    180          ENDIF 
    181  
    182          IF( ln_dm2dc ) THEN   ;   qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) )   ! modify now Qsr to include the diurnal cycle 
    183          ELSE                  ;   qsr(:,:) =          sf(jp_qsr)%fnow(:,:,1) 
    184          ENDIF 
    185 !CDIR COLLAPSE 
    186             !!UKMO SHELF effect of atmospheric pressure on SSH 
    187             ! If using ln_apr_dyn, this is done there so don't repeat here. 
    188             IF( ln_shelf_flx .AND. .NOT. ln_apr_dyn) THEN 
    189                DO jj = 1, jpjm1 
    190                   DO ji = 1, jpim1 
     182                  ELSE 
     183                     zwnd_i(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     184                     zwnd_j(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     185                  ENDIF 
     186                  wndm(ji,jj) = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 
     187 
     188                  ! add modification due to drag coefficient read from wave forcing  
     189                  IF( ln_cdgw .AND. nn_drag == jp_std ) THEN  
     190                     IF( cpl_wdrag ) THEN   
     191                        ! reset utau and vtau to the wind components: the momentum will  
     192                        ! be calculated from the coupled value of the drag coefficient  
     193                        utau(ji,jj) = zwnd_i(ji,jj)  
     194                        vtau(ji,jj) = zwnd_j(ji,jj)  
     195                     ELSE  
     196                        utau(ji,jj) = zrhoa * cdn_wave(ji,jj) * zwnd_i(ji,jj) * wndm(ji,jj) 
     197                        vtau(ji,jj) = zrhoa * cdn_wave(ji,jj) * zwnd_j(ji,jj) * wndm(ji,jj) 
     198                     ENDIF  
     199                  ELSE IF( nn_drag == jp_const ) THEN  
     200                     utau(ji,jj) = zrhoa * zcdrag * zwnd_i(ji,jj) * wndm(ji,jj) 
     201                     vtau(ji,jj) = zrhoa * zcdrag * zwnd_j(ji,jj) * wndm(ji,jj) 
     202                  ELSE IF( nn_drag == jp_ukmo ) THEN  
     203                     cs = 0.63 + (0.066 * wndm(ji,jj)) 
     204                     utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * wndm(ji,jj) 
     205                     vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * wndm(ji,jj) 
     206                  ENDIF  
     207                  taum(ji,jj) = sqrt(utau(ji,jj)*utau(ji,jj) + vtau(ji,jj)*vtau(ji,jj)) 
     208 
     209                  qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
     210                  !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 
     211                  qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 
     212                  !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 
     213                  emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 
     214               END DO 
     215            END DO 
     216            ! Move tau components to the right grid 
     217            DO jj = 1, jpjm1 
     218               DO ji = 1, jpim1 
     219                  utau(ji,jj) = 0.5 * ( utau(ji,jj) + utau(ji+1,jj) ) 
     220                  vtau(ji,jj) = 0.5 * ( vtau(ji,jj) + vtau(ji,jj+1) ) 
     221 
     222                  !!UKMO SHELF effect of atmospheric pressure on SSH 
     223                  ! If using ln_apr_dyn, this is done there so don't repeat here. 
     224                  IF( .NOT. ln_apr_dyn) THEN 
    191225                     apgu(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji+1,jj,1)-sf(jp_press)%fnow(ji,jj,1))/e1u(ji,jj) 
    192226                     apgv(ji,jj) = (-1.0/rau0)*(sf(jp_press)%fnow(ji,jj+1,1)-sf(jp_press)%fnow(ji,jj,1))/e2v(ji,jj) 
    193                   END DO 
    194                END DO 
    195             ENDIF ! ln_shelf_flx 
    196  
    197          DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
    198             DO ji = 1, jpi 
    199                    IF( ln_shelf_flx ) THEN 
    200                       !! UKMO SHELF - need atmospheric pressure to calculate Haney forcing 
    201                       pressnow(ji,jj) = sf(jp_press)%fnow(ji,jj,1) 
    202                       !! UKMO SHELF flux files contain wind speed not wind stress 
    203                       totwindspd = sqrt(zwnd_i(ji,jj)*zwnd_i(ji,jj) + zwnd_j(ji,jj)*zwnd_j(ji,jj)) 
    204                       cs = 0.63 + (0.066 * totwindspd) 
    205                       utau(ji,jj) = cs * (rhoa/rau0) * zwnd_i(ji,jj) * totwindspd 
    206                       vtau(ji,jj) = cs * (rhoa/rau0) * zwnd_j(ji,jj) * totwindspd 
    207                    ELSE 
    208                       utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
    209                       vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    210                    ENDIF 
    211                    qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
    212                    IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 
    213                       !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 
    214                       qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 
    215                       !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 
    216                       emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 
    217                    ELSE 
    218                       qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
    219                       emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
    220                    ENDIF 
    221             END DO 
    222          END DO 
    223          !                                                        ! add modification due to drag coefficient read from wave forcing  
    224          !                                                        ! this code is inefficient but put here to allow merging with another UKMO branch  
    225          IF( ln_shelf_flx ) THEN  
    226             ! calculate first the wind module, as it will be used later  
    227             DO jj = 2, jpjm1  
    228                DO ji = fs_2, fs_jpim1    ! vect. opt.  
    229                   ztx = zwnd_i(ji-1,jj  ) + zwnd_i(ji,jj)  
    230                   zty = zwnd_j(ji  ,jj-1) + zwnd_j(ji,jj)  
    231                   wndm(ji,jj) = 0.5 * SQRT( ztx * ztx + zty * zty )  
    232                END DO  
    233             END DO  
    234             CALL lbc_lnk( wndm(:,:), 'T', 1. )  
    235          
    236             IF( ln_cdgw .AND. nn_drag == jp_std ) THEN  
    237                IF( cpl_wdrag ) THEN   
    238                   ! reset utau and vtau to the wind components: the momentum will  
    239                   ! be calculated from the coupled value of the drag coefficient  
    240                   DO jj = 1, jpj  
    241                      DO ji = 1, jpi  
    242                         utau(ji,jj) = zwnd_i(ji,jj)  
    243                         vtau(ji,jj) = zwnd_j(ji,jj)  
    244                      END DO  
    245                   END DO  
    246                ELSE  
    247                   DO jj = 1, jpjm1  
    248                      DO ji = 1, jpim1  
    249                         utau(ji,jj) = zrhoa * 0.5 * ( cdn_wave(ji,jj) + cdn_wave(ji+1,jj) ) * zwnd_i(ji,jj) * &  
    250                                                                         0.5 * ( wndm(ji,jj) + wndm(ji+1,jj) )  
    251                         vtau(ji,jj) = zrhoa * 0.5 * ( cdn_wave(ji,jj) + cdn_wave(ji,jj+1) ) * zwnd_j(ji,jj) * &  
    252                                                                         0.5 * ( wndm(ji,jj) + wndm(ji,jj+1) )  
    253                      END DO  
    254                   END DO  
    255                   CALL lbc_lnk_multi( utau(:,:), 'U', -1., vtau(:,:), 'V', -1. )  
    256                ENDIF  
    257             ELSE IF( nn_drag == jp_const ) THEN  
    258                DO jj = 1, jpjm1  
    259                   DO ji = 1, jpim1  
    260                      utau(ji,jj) = zrhoa * zcdrag * zwnd_i(ji,jj) * 0.5 * ( wndm(ji,jj) + wndm(ji+1,jj) )  
    261                      vtau(ji,jj) = zrhoa * zcdrag * zwnd_j(ji,jj) * 0.5 * ( wndm(ji,jj) + wndm(ji,jj+1) )  
    262                   END DO  
    263                END DO  
    264                CALL lbc_lnk_multi( utau(:,:), 'U', -1., vtau(:,:), 'V', -1. )  
    265             ENDIF  
     227                  ENDIF 
     228               END DO 
     229            END DO 
     230         ELSE 
     231            DO jj = 1, jpj                                           ! set the ocean fluxes from read fields 
     232               DO ji = 1, jpi 
     233                  utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     234                  vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     235                  qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
     236                  IF( ln_foam_flx ) THEN 
     237                     !! UKMO FOAM flux files contain non-solar heat flux (qns) rather than total heat flux (qtot) 
     238                     qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) 
     239                     !! UKMO FOAM flux files contain the net DOWNWARD freshwater flux P-E rather then E-P 
     240                     emp (ji,jj) = -1. * sf(jp_emp )%fnow(ji,jj,1) 
     241                  ELSE 
     242                     qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
     243                     emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
     244                  ENDIF 
     245               END DO 
     246            END DO 
     247            !                                                        ! module of wind stress and wind speed at T-point 
     248            zcoef = 1. / ( zrhoa * zcdrag ) 
     249!CDIR NOVERRCHK 
     250            DO jj = 2, jpjm1 
     251!CDIR NOVERRCHK 
     252               DO ji = fs_2, fs_jpim1   ! vect. opt. 
     253                  ztx = utau(ji-1,jj  ) + utau(ji,jj)  
     254                  zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
     255                  zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
     256                  taum(ji,jj) = zmod 
     257                  wndm(ji,jj) = SQRT( zmod * zcoef ) 
     258               END DO 
     259            END DO 
    266260         ENDIF 
    267261         !                                                        ! add to qns the heat due to e-p 
    268262         qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    269263         ! 
    270     
    271             !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 
    272             IF( ln_foam_flx ) THEN 
    273                CALL lbc_lnk( utau(:,:), 'U', -1. ) 
    274                CALL lbc_lnk( vtau(:,:), 'V', -1. ) 
    275             ENDIF 
     264         !! UKMO FOAM wind fluxes need lbc_lnk calls owing to a bug in interp.exe 
     265         IF( ln_foam_flx .OR. ln_shelf_flx ) THEN 
     266            CALL lbc_lnk_multi( utau(:,:), 'U', -1., vtau(:,:), 'V', -1. )  
     267         ENDIF 
    276268     
    277          !                                                        ! module of wind stress and wind speed at T-point 
    278          zcoef = 1. / ( zrhoa * zcdrag ) 
    279 !CDIR NOVERRCHK 
    280          DO jj = 2, jpjm1 
    281 !CDIR NOVERRCHK 
    282             DO ji = fs_2, fs_jpim1   ! vect. opt. 
    283                ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    284                zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
    285                zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    286                taum(ji,jj) = zmod 
    287                IF ( .NOT. (ln_shelf_flx .AND. ln_cpl)) THEN 
    288                wndm(ji,jj) = SQRT( zmod * zcoef ) 
    289                ENDIF 
    290             END DO 
    291          END DO 
    292269         taum(:,:) = taum(:,:) * tmask(:,:,1) ; wndm(:,:) = wndm(:,:) * tmask(:,:,1) 
    293          CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
     270         CALL lbc_lnk_multi( taum(:,:), 'T', 1., wndm(:,:), 'T', 1. ) 
    294271 
    295272         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 
Note: See TracChangeset for help on using the changeset viewer.