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 4792 for branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90 – NEMO

Ignore:
Timestamp:
2014-09-26T13:04:47+02:00 (10 years ago)
Author:
jamesharle
Message:

Updates to code after first successful test + merge with HEAD of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90

    r4347 r4792  
    5757      !!                =1 global mean of emp set to zero at each nn_fsbc time step 
    5858      !!                =2 annual global mean corrected from previous year 
     59      !!                =3 global mean of emp set to zero at each nn_fsbc time step 
     60      !!                   & spread out over erp area depending its sign 
    5961      !! Note: if sea ice is embedded it is taken into account when computing the budget  
    6062      !!---------------------------------------------------------------------- 
     
    8183            IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero' 
    8284            IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget' 
    83          ENDIF 
     85            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area' 
     86         ENDIF 
     87         ! 
     88         IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 
    8489         ! 
    8590         area = glob_sum( e1e2t(:,:) )           ! interior global domain surface 
     
    142147         ENDIF 
    143148         ! 
     149      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==! 
     150         ! 
     151         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
     152            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp 
     153            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp 
     154            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 
     155            ! 
     156            zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp  
     157            zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
     158            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)  
     159            z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) - snwice_fmass(:,:) ) ) / area 
     160            !             
     161            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
     162                zsurf_tospread      = zsurf_pos 
     163                ztmsk_tospread(:,:) = ztmsk_pos(:,:) 
     164            ELSE                             ! spread out over <0 erp area to increase precipitation 
     165                zsurf_tospread      = zsurf_neg 
     166                ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
     167            ENDIF 
     168            ! 
     169            zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area 
     170!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so.... 
     171            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
     172            !                                                  ! weight to respect erp field 2D structure  
     173            zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
     174            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
     175            !                                                  ! final correction term to apply 
     176            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 
     177            ! 
     178!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain ! 
     179            CALL lbc_lnk( zerp_cor, 'T', 1. ) 
     180            ! 
     181            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
     182            qns(:,:) = qns(:,:) - zerp_cor(:,:) * rcp * sst_m(:,:)  ! account for change to the heat budget due to fw correction 
     183            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
     184            ! 
     185            IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     186               IF( z_fwf < 0._wp ) THEN 
     187                  WRITE(numout,*)'   z_fwf < 0' 
     188                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     189               ELSE 
     190                  WRITE(numout,*)'   z_fwf >= 0' 
     191                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2t(:,:) )*1.e-9,' Sv' 
     192               ENDIF 
     193               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2t(:,:) )*1.e-9,' Sv' 
     194               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s' 
     195               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s' 
     196               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor)  
     197               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor)  
     198            ENDIF 
     199         ENDIF 
     200         ! 
    144201      CASE DEFAULT                           !==  you should never be there  ==! 
    145          CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1 or 2' ) 
     202         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) 
    146203         ! 
    147204      END SELECT 
Note: See TracChangeset for help on using the changeset viewer.