Ignore:
Timestamp:
2018-12-19T22:54:16+01:00 (22 months ago)
Author:
smasson
Message:

trunk: merge back dev_r10164_HPC09_ESIWACE_PREP_MERGE@10424 into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/SBC/sbcfwb.F90

    r10068 r10425  
    7171      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztmsk_neg, ztmsk_pos, z_wgt ! 2D workspaces 
    7272      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztmsk_tospread, zerp_cor    !   -      - 
     73      REAL(wp)   ,DIMENSION(1) ::   z_fwfprv   
     74      COMPLEX(wp),DIMENSION(1) ::   y_fwfnow   
    7375      !!---------------------------------------------------------------------- 
    7476      ! 
     
    8688         IF( kn_fwb == 3 .AND. ln_isfcav    )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 with ln_isfcav = .TRUE. not working, we stop ' ) 
    8789         ! 
    88          area = glob_sum( e1e2t(:,:) * tmask(:,:,1))           ! interior global domain surface 
     90         area = glob_sum( 'sbcfwb', e1e2t(:,:) * tmask(:,:,1))           ! interior global domain surface 
    8991         ! isf cavities are excluded because it can feedback to the melting with generation of inhibition of plumes 
    9092         ! and in case of no melt, it can generate HSSW. 
     
    102104         ! 
    103105         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
    104             z_fwf = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area   ! sum over the global domain 
    105             zcoef = z_fwf * rcp 
    106             emp(:,:) = emp(:,:) - z_fwf              * tmask(:,:,1) 
     106            y_fwfnow(1) = local_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) 
     107            CALL mpp_delay_sum( 'sbcfwb', 'fwb', y_fwfnow(:), z_fwfprv(:), kt == nitend - nn_fsbc + 1 ) 
     108            z_fwfprv(1) = z_fwfprv(1) / area 
     109            zcoef = z_fwfprv(1) * rcp 
     110            emp(:,:) = emp(:,:) - z_fwfprv(1)        * tmask(:,:,1) 
    107111            qns(:,:) = qns(:,:) + zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 
    108112         ENDIF 
     
    127131            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
    128132                                                      ! sum over the global domain 
    129             a_fwb   = glob_sum( e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
     133            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
    130134            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s 
    131135!!gm        !                                                      !!bug 365d year  
     
    154158            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp 
    155159            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 
    156             ! 
    157             zsurf_neg = glob_sum( e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp  
    158             zsurf_pos = glob_sum( e1e2t(:,:)*ztmsk_pos(:,:) ) 
    159160            !                                                  ! fwf global mean (excluding ocean to ice/snow exchanges)  
    160             z_fwf     = glob_sum( e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 
     161            z_fwf     = glob_sum( 'sbcfwb', e1e2t(:,:) * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) - snwice_fmass(:,:) ) ) / area 
    161162            !             
    162163            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
    163                 zsurf_tospread      = zsurf_pos 
    164                 ztmsk_tospread(:,:) = ztmsk_pos(:,:) 
     164               zsurf_pos = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_pos(:,:) ) 
     165               zsurf_tospread      = zsurf_pos 
     166               ztmsk_tospread(:,:) = ztmsk_pos(:,:) 
    165167            ELSE                             ! spread out over <0 erp area to increase precipitation 
    166                 zsurf_tospread      = zsurf_neg 
    167                 ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
     168               zsurf_neg = glob_sum( 'sbcfwb', e1e2t(:,:)*ztmsk_neg(:,:) )  ! Area filled by <0 and >0 erp  
     169               zsurf_tospread      = zsurf_neg 
     170               ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
    168171            ENDIF 
    169172            ! 
    170             zsum_fwf   = glob_sum( e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area 
     173            zsum_fwf   = glob_sum( 'sbcfwb', e1e2t(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area 
    171174!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so.... 
    172175            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
    173176            !                                                  ! weight to respect erp field 2D structure  
    174             zsum_erp   = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
     177            zsum_erp   = glob_sum( 'sbcfwb', ztmsk_tospread(:,:) * erp(:,:) * e1e2t(:,:) ) 
    175178            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
    176179            !                                                  ! final correction term to apply 
     
    178181            ! 
    179182!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain ! 
    180             CALL lbc_lnk( zerp_cor, 'T', 1. ) 
     183            CALL lbc_lnk( 'sbcfwb', zerp_cor, 'T', 1. ) 
    181184            ! 
    182185            emp(:,:) = emp(:,:) + zerp_cor(:,:) 
Note: See TracChangeset for help on using the changeset viewer.