Changeset 2438


Ignore:
Timestamp:
2010-11-27T09:55:23+01:00 (10 years ago)
Author:
gm
Message:

v3.3beta: #764 correct a trivial bug in sbcfwb + style

File:
1 edited

Legend:

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

    r2287 r2438  
    44   !! Ocean fluxes   : domain averaged freshwater budget 
    55   !!====================================================================== 
    6    !! History :  8.2  !  01-02  (E. Durand)  Original code 
    7    !!            8.5  !  02-06  (G. Madec)  F90: Free form and module 
    8    !!            9.0  !  06-08  (G. Madec)  Surface module 
    9    !!            9.2  !  09-07  (C. Talandier) emp mean s spread over erp area  
     6   !! History :  OPA  ! 2001-02  (E. Durand)  Original code 
     7   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     8   !!            3.0  ! 2006-08  (G. Madec)  Surface module 
     9   !!            3.2  ! 2009-07  (C. Talandier) emp mean s spread over erp area  
    1010   !!---------------------------------------------------------------------- 
    1111 
     
    4343   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4444   !! $Id$ 
    45    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    4646   !!---------------------------------------------------------------------- 
    4747CONTAINS 
     
    7373      ! 
    7474      IF( kt == nit000 ) THEN 
    75          ! 
    7675         IF(lwp) THEN 
    7776            WRITE(numout,*) 
     
    8180            IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget' 
    8281            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area' 
    83             ! 
    84             IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   & 
    85                &   CALL ctl_stop( 'The option nn_fwb = 3 must be associated to nn_sssr = 2 ' ) 
    86              
    8782         ENDIF 
    8883         ! 
     84         IF( kn_fwb == 3 .AND. nn_sssr /= 2 )   CALL ctl_stop( 'sbc_fwb: nn_fwb = 3 requires nn_sssr = 2, we stop ' ) 
     85         ! 
    8986         e1e2(:,:) = e1t(:,:) * e2t(:,:)  
    90          area = glob_sum( e1e2(:,:) )   ! sum over the global domain 
    91          ! 
     87         area = glob_sum( e1e2(:,:) )           ! interior global domain surface 
    9288      ENDIF 
    9389       
     
    9591      SELECT CASE ( kn_fwb ) 
    9692      ! 
    97       CASE ( 0 )                                
    98          WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not yet associated to an option, choose either 1/2' 
    99          CALL ctl_stop( ctmp1 ) 
     93      CASE ( 1 )                             !==  global mean fwf set to zero  ==! 
    10094         ! 
    101           
    102       ! 
    103       CASE ( 1 )                               ! global mean fwf set to zero 
    10495         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
    10596            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area   ! sum over the global domain 
     
    10899         ENDIF 
    109100         ! 
    110       CASE ( 2 )                               ! fwf budget adjusted from the previous year 
    111          ! initialisation 
    112          IF( kt == nit000 ) THEN 
    113             ! Read the corrective factor on precipitations (fwfold) 
     101      CASE ( 2 )                             !==  fwf budget adjusted from the previous year  ==! 
     102         ! 
     103         IF( kt == nit000 ) THEN                   ! initialisation 
     104            !                                         ! Read the corrective factor on precipitations (fwfold) 
    114105            CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    115106            READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb 
    116107            CLOSE( inum ) 
    117             fwfold = a_fwb                  ! current year freshwater budget correction 
    118             !                               ! estimate from the previous year budget 
     108            fwfold = a_fwb                            ! current year freshwater budget correction 
     109            !                                         ! estimate from the previous year budget 
    119110            IF(lwp)WRITE(numout,*) 
    120111            IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', fwfold 
     
    122113            IF(lwp)WRITE(numout,*)'          year = ',iyear-2, ' freshwater budget read       = ', a_fwb_b 
    123114         ENDIF    
    124          !  
    125          ! Update fwfold if new year start 
     115         !                                         ! Update fwfold if new year start 
    126116         ikty = 365 * 86400 / rdttra(1)    !!bug  use of 365 days leap year or 360d year !!!!!!! 
    127117         IF( MOD( kt, ikty ) == 0 ) THEN 
     
    130120            a_fwb   = a_fwb * 1.e+3 / ( area * 86400. * 365. )     ! convert in Kg/m3/s = mm/s 
    131121!!gm        !                                                      !!bug 365d year  
    132             fwfold =  a_fwb                 ! current year freshwater budget correction 
    133             !                               ! estimate from the previous year budget 
     122            fwfold =  a_fwb                           ! current year freshwater budget correction 
     123            !                                         ! estimate from the previous year budget 
    134124         ENDIF 
    135125         !  
    136          ! correct the freshwater fluxes 
    137          IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
     126         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN      ! correct the freshwater fluxes 
    138127            emp (:,:) = emp (:,:) + fwfold 
    139128            emps(:,:) = emps(:,:) + fwfold 
    140129         ENDIF 
    141130         ! 
    142          ! save fwfold value in a file 
    143          IF( kt == nitend .AND. lwp ) THEN 
     131         IF( kt == nitend .AND. lwp ) THEN         ! save fwfold value in a file 
    144132            CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    145133            WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb 
     
    147135         ENDIF 
    148136         ! 
    149       CASE ( 3 )                               ! global fwf set to zero and spread out over erp area 
     137      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==! 
    150138         ! 
    151139         IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN 
    152             ! Select <0 and >0 area of erp 
    153             ztmsk_pos(:,:) = tmask_i(:,:) 
    154             WHERE( erp < 0.e0 ) ztmsk_pos = 0.e0 
     140            ztmsk_pos(:,:) = tmask_i(:,:)                      ! Select <0 and >0 area of erp 
     141            WHERE( erp < 0._wp )   ztmsk_pos = 0._wp 
    155142            ztmsk_neg(:,:) = tmask_i(:,:) - ztmsk_pos(:,:) 
    156  
    157             ! Area filled by <0 and >0 erp  
    158             zsurf_neg = glob_sum( e1e2(:,:)*ztmsk_neg(:,:) ) 
     143            ! 
     144            zsurf_neg = glob_sum( e1e2(:,:)*ztmsk_neg(:,:) )   ! Area filled by <0 and >0 erp  
    159145            zsurf_pos = glob_sum( e1e2(:,:)*ztmsk_pos(:,:) ) 
    160          
    161             ! fwf global mean  
     146            !                                                  ! fwf global mean  
    162147            z_fwf = glob_sum( e1e2(:,:) * ( emp(:,:) - rnf(:,:) ) ) / area 
    163              
    164             IF( z_fwf < 0.e0 ) THEN 
    165                 ! to spread out over >0 erp area to increase evaporation damping process 
    166                 zsurf_tospread = zsurf_pos 
     148            !             
     149            IF( z_fwf < 0._wp ) THEN         ! spread out over >0 erp area to increase evaporation 
     150                zsurf_tospread      = zsurf_pos 
    167151                ztmsk_tospread(:,:) = ztmsk_pos(:,:) 
    168             ELSE 
    169                 ! to spread out over <0 erp area to increase precipitation damping process 
    170                 zsurf_tospread = zsurf_neg 
     152            ELSE                             ! spread out over <0 erp area to increase precipitation 
     153                zsurf_tospread      = zsurf_neg 
    171154                ztmsk_tospread(:,:) = ztmsk_neg(:,:) 
    172155            ENDIF 
    173  
    174             ! fwf global mean over <0 or >0 erp area 
    175             zsum_fwf = glob_sum( e1e2(:,:) * z_fwf ) 
     156            ! 
     157            zsum_fwf   = glob_sum( e1e2(:,:) * z_fwf )         ! fwf global mean over <0 or >0 erp area 
     158!!gm :  zsum_fwf   = z_fwf * area   ???  it is right?  I think so.... 
    176159            z_fwf_nsrf =  zsum_fwf / ( zsurf_tospread + rsmall ) 
    177             ! weight to respect erp field 2D structure  
     160            !                                                  ! weight to respect erp field 2D structure  
    178161            zsum_erp = glob_sum( ztmsk_tospread(:,:) * erp(:,:) * e1e2(:,:) ) 
    179162            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
    180  
    181             ! final correction term to apply 
     163            !                                                  ! final correction term to apply 
    182164            zerp_cor(:,:) = -1. * z_fwf_nsrf * zsurf_tospread * z_wgt(:,:) 
    183  
     165            ! 
     166!!gm   ===>>>>  lbc_lnk should be useless as all the computation is done over the whole domain ! 
    184167            CALL lbc_lnk( zerp_cor, 'T', 1. ) 
    185  
     168            ! 
    186169            emp (:,:) = emp (:,:) + zerp_cor(:,:) 
    187170            emps(:,:) = emps(:,:) + zerp_cor(:,:) 
    188171            erp (:,:) = erp (:,:) + zerp_cor(:,:) 
    189              
    190             IF( nprint == 1 .AND. lwp ) THEN 
    191                IF( z_fwf < 0.e0 ) THEN 
    192                   WRITE(numout,*)'       z_fwf < 0' 
    193                   WRITE(numout,*)'       SUM(erp+)        = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-3,' m3.s-1' 
     172            ! 
     173            IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     174               IF( z_fwf < 0._wp ) THEN 
     175                  WRITE(numout,*)'   z_fwf < 0' 
     176                  WRITE(numout,*)'   SUM(erp+)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv' 
    194177               ELSE 
    195                    WRITE(numout,*)'      z_fwf >= 0' 
    196                    WRITE(numout,*)'      SUM(erp-)        = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-3,' m3.s-1' 
     178                  WRITE(numout,*)'   z_fwf >= 0' 
     179                  WRITE(numout,*)'   SUM(erp-)     = ', SUM( ztmsk_tospread(:,:)*erp(:,:)*e1e2(:,:) )*1.e-9,' Sv' 
    197180               ENDIF 
    198                WRITE(numout,*)'      SUM(empG)        = ', SUM( z_fwf*e1e2(:,:) )*1.e-3,' m3.s-1' 
    199                WRITE(numout,*)'      z_fwf            = ', z_fwf      ,' mm.s-1' 
    200                WRITE(numout,*)'      z_fwf_nsrf       = ', z_fwf_nsrf ,' mm.s-1' 
    201                WRITE(numout,*)'      MIN(zerp_cor)    = ', MINVAL(zerp_cor)  
    202                WRITE(numout,*)'      MAX(zerp_cor)    = ', MAXVAL(zerp_cor)  
     181               WRITE(numout,*)'   SUM(empG)     = ', SUM( z_fwf*e1e2(:,:) )*1.e-9,' Sv' 
     182               WRITE(numout,*)'   z_fwf         = ', z_fwf      ,' Kg/m2/s' 
     183               WRITE(numout,*)'   z_fwf_nsrf    = ', z_fwf_nsrf ,' Kg/m2/s' 
     184               WRITE(numout,*)'   MIN(zerp_cor) = ', MINVAL(zerp_cor)  
     185               WRITE(numout,*)'   MAX(zerp_cor) = ', MAXVAL(zerp_cor)  
    203186            ENDIF 
    204             ! 
    205187         ENDIF 
    206188         ! 
    207       CASE DEFAULT    ! you should never be there 
    208          WRITE(ctmp1,*)'sbc_fwb : nn_fwb = ', kn_fwb, ' is not permitted for the FreshWater Budget correction, choose either 1/2' 
    209          CALL ctl_stop( ctmp1 ) 
     189      CASE DEFAULT                           !==  you should never be there  ==! 
     190         CALL ctl_stop( 'sbc_fwb : wrong nn_fwb value for the FreshWater Budget correction, choose either 1, 2 or 3' ) 
    210191         ! 
    211192      END SELECT 
Note: See TracChangeset for help on using the changeset viewer.