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 – 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

Location:
branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
19 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r4147 r4792  
    212212      READ  ( numnam_cfg, namsbc_alb, IOSTAT = ios, ERR = 902 ) 
    213213902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in configuration namelist', lwp ) 
    214       WRITE ( numond, namsbc_alb ) 
     214      IF(lwm) WRITE ( numond, namsbc_alb ) 
    215215      ! 
    216216      IF(lwp) THEN                      ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r4694 r4792  
    4040      LOGICAL              ::   ln_clim     ! climatology or not (T/F) 
    4141      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
    42       CHARACTER(len = 34) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
     42      CHARACTER(len = 256) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
    4343      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation 
    4444      !                                     ! a string starting with "U" or "V" for each component    
    … …  
    489489            !       forcing record :    1  
    490490            !                             
    491             ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 + REAL( it_offset, wp ) 
     491            ztmp = REAL( nsec_year, wp ) / ( REAL( nyear_len(1), wp ) * rday ) + 0.5 & 
     492           &       + REAL( it_offset, wp ) / ( REAL( nyear_len(1), wp ) * rday ) 
    492493            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    493494            ! swap at the middle of the year 
    494             IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - NINT(0.5 * rday) * nyear_len(0) 
    495             ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + NINT(0.5 * rday) * nyear_len(1)    
     495            IF( llbefore ) THEN   ;   sdjf%nrec_a(2) = nsec1jan000 - (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(0) + & 
     496                                    & INT(ztmp) * NINT( 0.5 * rday) * nyear_len(1)  
     497            ELSE                  ;   sdjf%nrec_a(2) = nsec1jan000 + (1 - INT(ztmp)) * NINT(0.5 * rday) * nyear_len(1) + & 
     498                                    & INT(ztmp) * INT(rday) * nyear_len(1) + INT(ztmp) * NINT( 0.5 * rday) * nyear_len(2)  
    496499            ENDIF 
    497500         ELSE                                    ! no time interpolation 
    … …  
    517520            !       forcing record :  nmonth  
    518521            !                             
    519             ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 + REAL( it_offset, wp ) 
     522            ztmp = REAL( nsec_month, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) + 0.5 & 
     523           &       + REAL( it_offset, wp ) / ( REAL( nmonth_len(nmonth), wp ) * rday ) 
    520524            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    521525            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    … …  
    689693      !!---------------------------------------------------------------------- 
    690694#if defined key_bdy 
    691       USE bdy_oce, ONLY:  dta_global, dta_global2         ! workspace to read in global data arrays 
     695      USE bdy_oce, ONLY:  dta_global, dta_global_z, dta_global2, dta_global2_z         ! workspace to read in global data arrays 
    692696#endif  
    693697      INTEGER                   , INTENT(in ) ::   num     ! stream number 
    … …  
    706710      INTEGER                                 ::   ib, ik, ji, jj   ! loop counters 
    707711      INTEGER                                 ::   ierr 
     712      REAL(wp)                                ::   fv ! fillvalue and alternative -ABS(fv) 
    708713      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read    ! work space for global data 
    709714      REAL(wp), POINTER, DIMENSION(:,:,:)     ::   dta_read_z  ! work space for global data 
    … …  
    753758         END SELECT 
    754759         CALL iom_getatt(num, '_FillValue', fv, cdvar=clvar ) 
     760#if defined key_bdy 
    755761         CALL fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
     762#endif 
    756763      ELSE ! boundary data assumed to be on model grid 
    757764         CALL iom_get ( num, jpdom_unknown, clvar, dta_read(1:ilendta,1:ipj,1:ipk), nrec )                     
    … …  
    776783   END SUBROUTINE fld_map 
    777784    
     785#if defined key_bdy 
    778786   SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, map, jpk_bdy, igrd, ibdy, fv, dta) 
    779787 
    … …  
    784792      !!                boundary data from non-native vertical grid 
    785793      !!---------------------------------------------------------------------- 
    786 #if defined key_bdy 
    787794      USE bdy_oce, ONLY:  idx_bdy         ! indexing for map <-> ij transformation 
    788 #endif  
    789795 
    790796      REAL(wp), POINTER, DIMENSION(:,:,:), INTENT(in )     ::   dta_read    ! work space for global data 
    … …  
    792798      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   dta        ! output field on model grid (2 dimensional) 
    793799      INTEGER,  DIMENSION(:)    , INTENT(in ) ::   map        ! global-to-local mapping indices 
    794       INTEGER  , INTENT(in)                   ::   igrd, ib_bdy, jpk_bdy      ! number of levels in bdy data 
     800      INTEGER  , INTENT(in)                   ::   igrd, ibdy, jpk_bdy      ! number of levels in bdy data 
    795801      INTEGER                                 ::   jpkm1_bdy    ! number of levels in bdy data minus 1 
     802      REAL(wp) , INTENT(in)                                ::   fv ! fillvalue and alternative -ABS(fv) 
    796803      !! 
    797804      INTEGER                                 ::   ipi        ! length of boundary data on local process 
    … …  
    800807      INTEGER                                 ::   ilendta    ! length of data in file 
    801808      INTEGER                                 ::   ib, ik, ikk! loop counters 
     809      INTEGER                                 ::   ji, jj ! loop counters 
    802810      REAL(wp)                                ::   zl, zi     ! tmp variable for current depth and interpolation factor 
    803       REAL(wp)                                ::   fv, fv_alt ! fillvalue and alternative -ABS(fv) 
     811      REAL(wp)                                ::   fv_alt ! fillvalue and alternative -ABS(fv) 
    804812      !!--------------------------------------------------------------------- 
    805813 
    … …  
    824832         DO ib = 1, ipi 
    825833            DO ik = 1, ipk                       
    826                zl =  gdept_1(idx_bdy(ib_bdy)%nbi(ib,igrd),idx_bdy(ib_bdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_1? 
     834               zl =  gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_0? 
    827835               IF( zl < dta_read_z(map(ib),1,1) ) THEN                                         ! above the first level of external data 
    828836                  dta(ib,1,ik) =  dta_read(map(ib),1,1) 
    … …  
    830838                  dta(ib,1,ik) =  dta_read(map(ib),1,MAXLOC(dta_read_z(map(ib),1,:),1)) 
    831839               ELSE                                                                          ! inbetween : vertical interpolation between ikk & ikk+1 
    832                   DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_1(ikk) < zl < gdept_1(ikk+1) 
     840                  DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_0(ikk) < zl < gdept_0(ikk+1) 
    833841                     IF( ( (zl-dta_read_z(map(ib),1,ikk)) * (zl-dta_read_z(map(ib),1,ikk+1)) <= 0._wp)   & 
    834842                    &    .AND. (dta_read_z(map(ib),1,ikk+1) /= fv_alt)) THEN 
    … …  
    857865            ji=map(ib)-(jj-1)*ilendta 
    858866            DO ik = 1, ipk                       
    859                zl =  gdept_1(idx_bdy(ib_bdy)%nbi(ib,igrd),idx_bdy(ib_bdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_1? 
     867               zl =  gdept_0(idx_bdy(ibdy)%nbi(ib,igrd),idx_bdy(ibdy)%nbj(ib,igrd),ik)   ! if using in step could use fsdept instead of gdept_0? 
    860868               IF( zl < dta_read_z(ji,jj,1) ) THEN                                         ! above the first level of external data 
    861                   dta(ib,1,ik) =  dta_read(ji,jj,1,1) 
     869                  dta(ib,1,ik) =  dta_read(ji,jj,1) 
    862870               ELSEIF( zl > MAXVAL(dta_read_z(ji,ji,:),1) ) THEN                           ! below the last level of external data  
    863871                  dta(ib,1,ik) =  dta_read(ji,jj,MAXLOC(dta_read_z(ji,jj,:),1)) 
    864872               ELSE                                                                          ! inbetween : vertical interpolation between ikk & ikk+1 
    865                   DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_1(ikk) < zl < gdept_1(ikk+1) 
     873                  DO ikk = 1, jpkm1_bdy                                                          ! when  gdept_0(ikk) < zl < gdept_0(ikk+1) 
    866874                     IF( ( (zl-dta_read_z(ji,jj,ikk)) * (zl-dta_read_z(ji,jj,ikk+1)) <= 0._wp)   & 
    867875                    &    .AND. (dta_read_z(ji,jj,ikk+1) /= fv_alt)) THEN 
    868876                        zi = ( zl - dta_read_z(ji,jj,ikk) ) / (dta_read_z(ji,jj,ikk+1)-dta_read_z(ji,jj,ikk)) 
    869877                        dta(ib,1,ik) = dta_read(ji,jj,ikk) + & 
    870                       &                ( dta_read(ji,jj,1,ikk+1) -  dta_read(ji,jj,ikk) ) * zi 
     878                      &                ( dta_read(ji,jj,ikk+1) -  dta_read(ji,jj,ikk) ) * zi 
    871879                     ENDIF 
    872880                  END DO 
    … …  
    877885 
    878886   END SUBROUTINE fld_bdy_interp 
     887#endif 
    879888 
    880889   SUBROUTINE fld_rot( kt, sd ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r4604 r4792  
    8181         READ  ( numnam_cfg, namsbc_ana, IOSTAT = ios, ERR = 902 ) 
    8282902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ana in configuration namelist', lwp ) 
    83          WRITE ( numond, namsbc_ana ) 
     83         IF(lwm) WRITE ( numond, namsbc_ana ) 
    8484         ! 
    8585         IF(lwp) WRITE(numout,*)' ' 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r4328 r4792  
    8383         READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 ) 
    8484902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp ) 
    85          WRITE ( numond, namsbc_apr ) 
     85         IF(lwm) WRITE ( numond, namsbc_apr ) 
    8686         ! 
    8787         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r4147 r4792  
    148148         READ  ( numnam_cfg, namsbc_clio, IOSTAT = ios, ERR = 902 ) 
    149149902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_clio in configuration namelist', lwp ) 
    150          WRITE ( numond, namsbc_clio ) 
     150         IF(lwm) WRITE ( numond, namsbc_clio ) 
    151151 
    152152         ! store namelist information in an array 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r4333 r4792  
    154154902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_core in configuration namelist', lwp ) 
    155155 
    156          WRITE ( numond, namsbc_core ) 
     156         IF(lwm) WRITE ( numond, namsbc_core ) 
    157157         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 
    158158         IF( ln_dm2dc .AND. sn_qsr%nfreqh /= 24 )   &  
    … …  
    563563      zcoef_dqsb   = rhoa * cpa * Cice 
    564564      zcoef_frca   = 1.0  - 0.3 
     565      ! MV 2014 the proper cloud fraction (mean summer months from the CLIO climato, NH+SH) is 0.19 
     566      zcoef_frca   = 1.0  - 0.19 
    565567 
    566568!!gm brutal.... 
    … …  
    648650               p_qsr(ji,jj,jl) = zztmp * ( 1. - palb(ji,jj,jl) ) * qsr(ji,jj) 
    649651               ! Long  Wave (lw) 
    650                ! iovino 
    651                IF( ff(ji,jj) .GT. 0._wp ) THEN 
    652                   z_qlw(ji,jj,jl) = ( 0.95 * sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    653                ELSE 
    654                   z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    655                ENDIF 
     652               z_qlw(ji,jj,jl) = 0.95 * ( sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3 ) * tmask(ji,jj,1) 
    656653               ! lw sensitivity 
    657654               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
    … …  
    668665                  &                         * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    669666               ! Latent heat sensitivity for ice (Dqla/Dt) 
    670                p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     667               ! MV we also have to cap the sensitivity if the flux is zero 
     668               IF ( p_qla(ji,jj,jl) .GT. 0.0 ) THEN 
     669                  p_dqla(ji,jj,jl) = rn_efac * zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     670               ELSE 
     671                  p_dqla(ji,jj,jl) = 0.0 
     672               ENDIF 
     673                              
    671674               ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 
    672675               z_dqsb(ji,jj,jl) = zcoef_dqsb * z_wnds_t(ji,jj) 
    … …  
    820823           sqrt_Cd=kappa/((kappa/sqrt_Cd_n10) - zpsi_m) ; Cd=sqrt_Cd*sqrt_Cd; 
    821824         ELSE 
    822            !! Shifting the wind speed to 10m and neutral stability : 
    823            U_n10 = dU10*1./(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) !  L & Y eq. (9a) 
     825           !! Shifting the wind speed to 10m and neutral stability :  L & Y eq. (9a) 
     826           !   In very rare low-wind conditions, the old way of estimating the 
     827           !   neutral wind speed at 10m leads to a negative value that causes the code 
     828           !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
     829           U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    824830 
    825831           !! Updating the neutral 10m transfer coefficients : 
    … …  
    956962         zpsi_m  = psi_m(zeta_u) 
    957963         !! 
    958          !! Shifting the wind speed to 10m and neutral stability : (L & Y eq.(9a)) 
    959 !        U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - psi_m(zeta_u))) 
    960          U_n10 = dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) 
     964         !! Shifting the wind speed to 10m and neutral stability : L & Y eq.(9a) 
     965         !   In very rare low-wind conditions, the old way of estimating the 
     966         !   neutral wind speed at 10m leads to a negative value that causes the code 
     967         !   to crash. To prevent this a threshold of 0.25m/s is now imposed. 
     968         U_n10 = MAX( 0.25 , dU10/(1. + sqrt_Cd_n10/kappa*(log(zu/10.) - zpsi_m)) ) 
    961969         !! 
    962970         !! Shifting temperature and humidity at zu :          (L & Y eq. (9b-9c)) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r4147 r4792  
    141141         READ  ( numnam_cfg, namsbc_mfs, IOSTAT = ios, ERR = 902 ) 
    142142902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_mfs in configuration namelist', lwp ) 
    143          WRITE ( numond, namsbc_mfs ) 
     143         IF(lwm) WRITE ( numond, namsbc_mfs ) 
    144144         ! 
    145145         ! store namelist information in an array 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r4393 r4792  
    244244      READ  ( numnam_cfg, namsbc_cpl, IOSTAT = ios, ERR = 902 ) 
    245245902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cpl in configuration namelist', lwp ) 
    246       WRITE ( numond, namsbc_cpl ) 
     246      IF(lwm) WRITE ( numond, namsbc_cpl ) 
    247247 
    248248      IF(lwp) THEN                        ! control print 
    … …  
    13741374            END SELECT 
    13751375         CASE( 'mixed oce-ice'        )    
    1376             ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:)  
     1376            ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:)  
    13771377            DO jl=1,jpl 
    13781378               ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r4147 r4792  
    9898         READ  ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 ) 
    9999902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist', lwp ) 
    100          WRITE ( numond, namsbc_flx )  
     100         IF(lwm) WRITE ( numond, namsbc_flx )  
    101101         ! 
    102102         !                                         ! check: do we plan to use ln_dm2dc with non-daily forcing? 

  • 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 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r4292 r4792  
    6060   PUBLIC sbc_ice_cice    ! routine called by sbc 
    6161 
    62    INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 ) 
    63    INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 ) 
     62   INTEGER             ::   ji_off 
     63   INTEGER             ::   jj_off 
    6464 
    6565   INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read  
    … …  
    158158      IF(lwp) WRITE(numout,*)'cice_sbc_init' 
    159159 
     160      ji_off = INT ( (jpiglo - nx_global) / 2 ) 
     161      jj_off = INT ( (jpjglo - ny_global) / 2 ) 
     162 
    160163! Initialize CICE 
    161164      CALL CICE_Initialize 
    … …  
    220223         sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
    221224         ! 
    222          ! Note: Changed the initial values of sshb and sshn=>  need to recompute ssh[u,v,f]_[b,n]  
    223          !       which were previously set in domvvl 
    224          IF ( lk_vvl ) THEN            ! Is this necessary? embd 2 should be restricted to vvl only??? 
    225             DO jj = 1, jpjm1 
    226                DO ji = 1, jpim1                    ! caution: use of Vector Opt. not possible 
    227                   zcoefu = 0.5  * umask(ji,jj,1) / ( e1u(ji,jj) * e2u(ji,jj) ) 
    228                   zcoefv = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj) * e2v(ji,jj) ) 
    229                   zcoeff = 0.25 * umask(ji,jj,1) * umask(ji,jj+1,1) 
    230                   sshu_b(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshb(ji  ,jj)     & 
    231                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshb(ji+1,jj) ) 
    232                   sshv_b(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshb(ji,jj  )     & 
    233                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshb(ji,jj+1) ) 
    234                   sshu_n(ji,jj) = zcoefu * ( e1t(ji  ,jj) * e2t(ji  ,jj) * sshn(ji  ,jj)     & 
    235                      &                     + e1t(ji+1,jj) * e2t(ji+1,jj) * sshn(ji+1,jj) ) 
    236                   sshv_n(ji,jj) = zcoefv * ( e1t(ji,jj  ) * e2t(ji,jj  ) * sshn(ji,jj  )     & 
    237                      &                     + e1t(ji,jj+1) * e2t(ji,jj+1) * sshn(ji,jj+1) ) 
    238                END DO 
    239             END DO 
    240             CALL lbc_lnk( sshu_b, 'U', 1. )   ;   CALL lbc_lnk( sshu_n, 'U', 1. ) 
    241             CALL lbc_lnk( sshv_b, 'V', 1. )   ;   CALL lbc_lnk( sshv_n, 'V', 1. ) 
    242             DO jj = 1, jpjm1 
    243                DO ji = 1, jpim1      ! NO Vector Opt. 
    244                   sshf_n(ji,jj) = 0.5  * umask(ji,jj,1) * umask(ji,jj+1,1)                   & 
    245                        &               / ( e1f(ji,jj  ) * e2f(ji,jj  ) )                     & 
    246                        &               * ( e1u(ji,jj  ) * e2u(ji,jj  ) * sshu_n(ji,jj  )     & 
    247                        &                 + e1u(ji,jj+1) * e2u(ji,jj+1) * sshu_n(ji,jj+1) ) 
    248                END DO 
    249             END DO 
    250             CALL lbc_lnk( sshf_n, 'F', 1. ) 
    251           ENDIF 
    252225      ENDIF 
    253226  
    … …  
    747720         READ  ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 ) 
    748721902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist', lwp ) 
    749          WRITE ( numond, namsbc_cice ) 
     722         IF(lwm) WRITE ( numond, namsbc_cice ) 
    750723 
    751724         ! store namelist information in an array 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r4161 r4792  
    7878         READ  ( numnam_cfg, namsbc_iif, IOSTAT = ios, ERR = 902 ) 
    7979902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_iif in configuration namelist', lwp ) 
    80          WRITE ( numond, namsbc_iif ) 
     80         IF(lwm) WRITE ( numond, namsbc_iif ) 
    8181 
    8282         ALLOCATE( sf_ice(1), STAT=ierror ) 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90

    r4333 r4792  
    5959   USE prtctl          ! Print control 
    6060   USE lib_fortran     !  
     61   USE cpl_oasis3, ONLY : lk_cpl 
    6162 
    6263#if defined key_bdy  
    … …  
    6869 
    6970   PUBLIC sbc_ice_lim  ! routine called by sbcmod.F90 
     71   PUBLIC lim_prt_state 
    7072    
    7173   !! * Substitutions 
    … …  
    133135      INTEGER, INTENT(in) ::   kblk    ! type of bulk (=3 CLIO, =4 CORE) 
    134136      !! 
    135       INTEGER  ::   jl      ! dummy loop index 
     137      INTEGER  ::   ji, jj, jl, jk      ! dummy loop index 
    136138      REAL(wp) ::   zcoef   ! local scalar 
    137139      REAL(wp), POINTER, DIMENSION(:,:,:)   ::   zalb_ice_os, zalb_ice_cs  ! albedo of the ice under overcast/clear sky 
    … …  
    146148      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqns_ice_all  ! Mean d(qns)/dT over all categories 
    147149      REAL(wp), POINTER, DIMENSION(:,:) :: z_dqla_ice_all  ! Mean d(qla)/dT over all categories 
     150      REAL(wp) ::   ztmelts           ! clem 2014: for HC diags 
     151      REAL(wp) ::   epsi20 = 1.e-20   ! 
    148152      !!---------------------------------------------------------------------- 
    149153 
    … …  
    152156      IF( nn_timing == 1 )  CALL timing_start('sbc_ice_lim') 
    153157 
    154       CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    155  
    156 #if defined key_coupled 
    157       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_alloc( jpi,jpj,jpl, zalb_ice) 
    158       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    159          &   CALL wrk_alloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    160 #endif 
     158      CALL wrk_alloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     159 
     160      IF( lk_cpl ) THEN 
     161         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     162            &   CALL wrk_alloc( jpi, jpj, ztem_ice_all , zalb_ice_all  , z_qsr_ice_all, z_qns_ice_all,  & 
     163            &                            z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     164      ENDIF 
    161165 
    162166      IF( kt == nit000 ) THEN 
    … …  
    168172         ! 
    169173         IF( ln_nicep ) THEN      ! control print at a given point 
    170             jiindx = 177   ;   jjindx = 112 
     174            jiindx = 15    ;   jjindx =  44 
    171175            IF(lwp) WRITE(numout,*) ' The debugging point is : jiindx : ',jiindx, ' jjindx : ',jjindx 
    172176         ENDIF 
    … …  
    176180      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN     !  Ice time-step only  ! 
    177181         !                                     !----------------------! 
    178          !                                           !  Bulk Formulea ! 
     182         !                                           !  Bulk Formulae ! 
    179183         !                                           !----------------! 
    180184         ! 
    181185         u_oce(:,:) = ssu_m(:,:)                     ! mean surface ocean current at ice velocity point 
    182186         v_oce(:,:) = ssv_m(:,:)                     ! (C-grid dynamics :  U- & V-points as the ocean) 
    183          ! 
    184          t_bo(:,:) = tfreez( sss_m ) +  rt0          ! masked sea surface freezing temperature [Kelvin] 
    185          !                                           ! (set to rt0 over land) 
     187 
     188         ! masked sea surface freezing temperature [Kelvin] 
     189         t_bo(:,:) = ( tfreez( sss_m ) +  rt0 ) * tmask(:,:,1) + rt0 * ( 1. - tmask(:,:,1) ) 
     190 
    186191         CALL albedo_ice( t_su, ht_i, ht_s, zalb_ice_cs, zalb_ice_os )  ! ... ice albedo 
    187192 
    … …  
    192197         IF ( ln_cpl ) zalb_ice (:,:,:) = 0.5 * ( zalb_ice_cs (:,:,:) +  zalb_ice_os (:,:,:) ) 
    193198          
    194 #if defined key_coupled 
    195          IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    196             ! 
    197             ! Compute mean albedo and temperature 
    198             zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
    199             ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
    200             ! 
     199         IF( lk_cpl ) THEN 
     200            IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
     201               ! 
     202               ! Compute mean albedo and temperature 
     203               zalb_ice_all (:,:) = fice_ice_ave ( zalb_ice (:,:,:) )  
     204               ztem_ice_all (:,:) = fice_ice_ave ( tn_ice   (:,:,:) )  
     205               ! 
     206            ENDIF 
    201207         ENDIF 
    202 #endif 
    203208                                               ! Bulk formulea - provides the following fields: 
    204209         ! utau_ice, vtau_ice : surface ice stress                     (U- & V-points)   [N/m2] 
    … …  
    218223            !          
    219224         CASE( 4 )                                       ! CORE bulk formulation 
    220             CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice_cs,               & 
     225            ! MV 2014 
     226            ! We must account for cloud fraction in the computation of the albedo 
     227            ! The present ref just uses the clear sky value 
     228            ! The overcast sky value is 0.06 higher, and polar skies are mostly overcast 
     229            ! CORE has no cloud fraction, hence we must prescribe it 
     230            ! Mean summer cloud fraction computed from CLIO = 0.81 
     231            zalb_ice(:,:,:) = 0.19 * zalb_ice_cs(:,:,:) + 0.81 * zalb_ice_os(:,:,:) 
     232            ! Following line, we replace zalb_ice_cs by simply zalb_ice 
     233            CALL blk_ice_core( t_su , u_ice     , v_ice     , zalb_ice   ,               & 
    221234               &                      utau_ice  , vtau_ice  , qns_ice    , qsr_ice   ,   & 
    222235               &                      qla_ice   , dqns_ice  , dqla_ice   ,               & 
    … …  
    239252 
    240253         ! Average over all categories 
    241 #if defined key_coupled 
     254         IF( lk_cpl ) THEN 
    242255         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) THEN 
    243256 
    … …  
    269282            END IF 
    270283         END IF 
    271 #endif 
     284         ENDIF 
    272285         !                                           !----------------------! 
    273286         !                                           ! LIM-3  time-stepping ! 
    … …  
    285298         old_smv_i(:,:,:)   = smv_i(:,:,:)     ! salt content 
    286299         old_oa_i (:,:,:)   = oa_i (:,:,:)     ! areal age content 
    287          ! 
    288          old_u_ice(:,:) = u_ice(:,:) 
    289          old_v_ice(:,:) = v_ice(:,:) 
    290          !                                           ! intialisation to zero    !!gm is it truly necessary ??? 
     300         old_u_ice(:,:)     = u_ice(:,:) 
     301         old_v_ice(:,:)     = v_ice(:,:) 
     302 
     303         ! trends    !!gm is it truly necessary ??? 
    291304         d_a_i_thd  (:,:,:)   = 0._wp   ;   d_a_i_trp  (:,:,:)   = 0._wp 
    292305         d_v_i_thd  (:,:,:)   = 0._wp   ;   d_v_i_trp  (:,:,:)   = 0._wp 
    … …  
    296309         d_smv_i_thd(:,:,:)   = 0._wp   ;   d_smv_i_trp(:,:,:)   = 0._wp 
    297310         d_oa_i_thd (:,:,:)   = 0._wp   ;   d_oa_i_trp (:,:,:)   = 0._wp 
    298          ! 
    299          d_u_ice_dyn(:,:) = 0._wp 
    300          d_v_ice_dyn(:,:) = 0._wp 
    301          ! 
    302          sfx    (:,:) = 0._wp   ;   sfx_thd  (:,:) = 0._wp 
    303          sfx_bri(:,:) = 0._wp   ;   sfx_mec  (:,:) = 0._wp   ;   sfx_res  (:,:) = 0._wp 
    304          fhbri  (:,:) = 0._wp   ;   fheat_mec(:,:) = 0._wp   ;   fheat_res(:,:) = 0._wp 
    305          fhmec  (:,:) = 0._wp   ;    
    306          fmmec  (:,:) = 0._wp 
    307          fmmflx (:,:) = 0._wp      
    308          focea2D(:,:) = 0._wp 
    309          fsup2D (:,:) = 0._wp 
    310  
    311          ! used in limthd.F90 
    312          rdvosif(:,:) = 0._wp   ! variation of ice volume at surface 
    313          rdvobif(:,:) = 0._wp   ! variation of ice volume at bottom 
    314          fdvolif(:,:) = 0._wp   ! total variation of ice volume 
    315          rdvonif(:,:) = 0._wp   ! lateral variation of ice volume 
    316          fstric (:,:) = 0._wp   ! part of solar radiation transmitted through the ice 
    317          ffltbif(:,:) = 0._wp   ! linked with fstric 
    318          qfvbq  (:,:) = 0._wp   ! linked with fstric 
    319          rdm_snw(:,:) = 0._wp   ! variation of snow mass per unit area 
    320          rdm_ice(:,:) = 0._wp   ! variation of ice mass per unit area 
    321          hicifp (:,:) = 0._wp   ! daily thermodynamic ice production.  
    322          ! 
    323          diag_sni_gr(:,:) = 0._wp   ;   diag_lat_gr(:,:) = 0._wp 
    324          diag_bot_gr(:,:) = 0._wp   ;   diag_dyn_gr(:,:) = 0._wp 
    325          diag_bot_me(:,:) = 0._wp   ;   diag_sur_me(:,:) = 0._wp 
    326          diag_res_pr(:,:) = 0._wp   ;   diag_trp_vi(:,:) = 0._wp 
     311         d_u_ice_dyn(:,:)     = 0._wp   ;   d_v_ice_dyn(:,:)     = 0._wp 
     312 
     313         ! salt, heat and mass fluxes 
     314         sfx    (:,:) = 0._wp   ; 
     315         sfx_bri(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp  
     316         sfx_sni(:,:) = 0._wp   ;   sfx_opw(:,:) = 0._wp 
     317         sfx_bog(:,:) = 0._wp   ;   sfx_dyn(:,:) = 0._wp 
     318         sfx_bom(:,:) = 0._wp   ;   sfx_sum(:,:) = 0._wp 
     319         sfx_res(:,:) = 0._wp 
     320 
     321         wfx_snw(:,:) = 0._wp   ;   wfx_ice(:,:) = 0._wp 
     322         wfx_sni(:,:) = 0._wp   ;   wfx_opw(:,:) = 0._wp 
     323         wfx_bog(:,:) = 0._wp   ;   wfx_dyn(:,:) = 0._wp 
     324         wfx_bom(:,:) = 0._wp   ;   wfx_sum(:,:) = 0._wp 
     325         wfx_res(:,:) = 0._wp   ;   wfx_sub(:,:) = 0._wp 
     326         wfx_spr(:,:) = 0._wp   ;    
     327 
     328         hfx_in (:,:) = 0._wp   ;   hfx_out(:,:) = 0._wp 
     329         hfx_thd(:,:) = 0._wp   ;    
     330         hfx_snw(:,:) = 0._wp   ;   hfx_opw(:,:) = 0._wp 
     331         hfx_bog(:,:) = 0._wp   ;   hfx_dyn(:,:) = 0._wp 
     332         hfx_bom(:,:) = 0._wp   ;   hfx_sum(:,:) = 0._wp 
     333         hfx_res(:,:) = 0._wp   ;   hfx_sub(:,:) = 0._wp 
     334         hfx_spr(:,:) = 0._wp   ;   hfx_dif(:,:) = 0._wp  
     335         hfx_err(:,:) = 0._wp   ;   hfx_err_rem(:,:) = 0._wp 
     336 
     337         ! 
     338         fhld  (:,:)    = 0._wp  
     339         fmmflx(:,:)    = 0._wp      
     340         ! part of solar radiation transmitted through the ice 
     341         ftr_ice(:,:,:) = 0._wp 
     342 
     343         ! diags 
     344         diag_trp_vi  (:,:) = 0._wp  ; diag_trp_vs(:,:) = 0._wp  ;  diag_trp_ei(:,:) = 0._wp  ;  diag_trp_es(:,:) = 0._wp 
     345         diag_heat_dhc(:,:) = 0._wp   
     346 
    327347         ! dynamical invariants 
    328348         delta_i(:,:) = 0._wp       ;   divu_i(:,:) = 0._wp       ;   shear_i(:,:) = 0._wp 
    … …  
    375395                          zcoef = rdt_ice /rday           !  Ice natural aging 
    376396                          oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * zcoef 
    377                           CALL lim_var_glo2eqv            ! this CALL is maybe not necessary (Martin) 
    378397         IF( ln_nicep )   CALL lim_prt_state( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' )   ! control print 
    379398                          CALL lim_itd_th( kt )           !  Remap ice categories, lateral accretion  ! 
    … …  
    391410         !                                           ! Diagnostics and outputs  
    392411         IF (ln_limdiaout) CALL lim_diahsb 
    393 !clem # if ! defined key_iomput 
     412 
    394413                          CALL lim_wri( 1  )              ! Ice outputs  
    395 !clem # endif 
     414 
    396415         IF( kt == nit000 .AND. ln_rstart )   & 
    397416            &             CALL iom_close( numrir )        ! clem: close input ice restart file 
    … …  
    413432       
    414433!!gm   remark, the ocean-ice stress is not saved in ice diag call above .....  find a solution!!! 
    415       ! 
    416       CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs ) 
    417  
    418 #if defined key_coupled 
    419       IF ( ln_cpl .OR. ln_iceflx_ave .OR. ln_iceflx_linear ) CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice) 
    420       IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
    421          &    CALL wrk_dealloc( jpi,jpj, ztem_ice_all, zalb_ice_all, z_qsr_ice_all, z_qns_ice_all, z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
    422 #endif 
     434      CALL wrk_dealloc( jpi,jpj,jpl, zalb_ice_os, zalb_ice_cs, zalb_ice ) 
     435 
     436      IF( lk_cpl ) THEN 
     437         IF ( ln_iceflx_ave .OR. ln_iceflx_linear ) & 
     438            &    CALL wrk_dealloc( jpi, jpj, ztem_ice_all , zalb_ice_all , z_qsr_ice_all, z_qns_ice_all,   & 
     439            &                                z_qla_ice_all, z_dqns_ice_all, z_dqla_ice_all) 
     440      ENDIF 
    423441      ! 
    424442      IF( nn_timing == 1 )  CALL timing_stop('sbc_ice_lim') 
    … …  
    534552!                 WRITE(numout,*) ' sst                  : ', sst_m(ji,jj) 
    535553!                 WRITE(numout,*) ' sss                  : ', sss_m(ji,jj) 
    536 !                 WRITE(numout,*) ' s_i_newice           : ', s_i_newice(ji,jj,1:jpl) 
    537554!                 WRITE(numout,*)  
    538555                  inb_alp(ialert_id) = inb_alp(ialert_id) + 1 
    … …  
    591608               !WRITE(numout,*) ' sst       : ', sst_m(ji,jj) 
    592609               !WRITE(numout,*) ' sss       : ', sss_m(ji,jj) 
    593                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) 
    594                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) 
    595                !WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) / rdt_ice 
    596                !WRITE(numout,*) ' qldif     : ', qldif(ji,jj) / rdt_ice 
    597                !WRITE(numout,*) ' qfvbq     : ', qfvbq(ji,jj) 
    598                !WRITE(numout,*) ' qdtcn     : ', qdtcn(ji,jj) 
    599                !WRITE(numout,*) ' qfvbq / dt: ', qfvbq(ji,jj) / rdt_ice 
    600                !WRITE(numout,*) ' qdtcn / dt: ', qdtcn(ji,jj) / rdt_ice 
    601                !WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj)  
    602                !WRITE(numout,*) ' fhmec     : ', fhmec(ji,jj)  
    603                !WRITE(numout,*) ' fheat_mec : ', fheat_mec(ji,jj)  
    604                !WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj)  
    605                !WRITE(numout,*) ' fhbri     : ', fhbri(ji,jj)  
    606610               ! 
    607611               !CALL lim_prt_state( kt, ji, jj, 2, '   ') 
    … …  
    790794               WRITE(numout,*) ' - Heat / FW fluxes ' 
    791795               WRITE(numout,*) '   ~~~~~~~~~~~~~~~~ ' 
    792                WRITE(numout,*) ' emp        : ', emp      (ji,jj) 
    793                WRITE(numout,*) ' sfx        : ', sfx      (ji,jj) 
    794                WRITE(numout,*) ' sfx_thd    : ', sfx_thd(ji,jj) 
    795                WRITE(numout,*) ' sfx_bri    : ', sfx_bri  (ji,jj) 
    796                WRITE(numout,*) ' sfx_mec    : ', sfx_mec  (ji,jj) 
    797                WRITE(numout,*) ' sfx_res    : ', sfx_res(ji,jj) 
    798                WRITE(numout,*) ' fmmec      : ', fmmec    (ji,jj) 
    799                WRITE(numout,*) ' fhmec      : ', fhmec    (ji,jj) 
    800                WRITE(numout,*) ' fhbri      : ', fhbri    (ji,jj) 
    801                WRITE(numout,*) ' fheat_mec  : ', fheat_mec(ji,jj) 
     796               WRITE(numout,*) ' - Heat fluxes in and out the ice ***' 
     797               WRITE(numout,*) ' qsr_ini       : ', pfrld(ji,jj) * qsr(ji,jj) + SUM( old_a_i(ji,jj,:) * qsr_ice(ji,jj,:) ) 
     798               WRITE(numout,*) ' qns_ini       : ', pfrld(ji,jj) * qns(ji,jj) + SUM( old_a_i(ji,jj,:) * qns_ice(ji,jj,:) ) 
     799               WRITE(numout,*) 
    802800               WRITE(numout,*)  
    803801               WRITE(numout,*) ' sst        : ', sst_m(ji,jj)   
    … …  
    829827               WRITE(numout,*) ' qsr       : ', qsr(ji,jj) 
    830828               WRITE(numout,*) ' qns       : ', qns(ji,jj) 
    831                WRITE(numout,*) ' fdtcn     : ', fdtcn(ji,jj) 
    832                WRITE(numout,*) ' qcmif     : ', qcmif(ji,jj) * r1_rdtice 
    833                WRITE(numout,*) ' qldif     : ', qldif(ji,jj) * r1_rdtice 
     829               WRITE(numout,*) 
     830               WRITE(numout,*) ' hfx_mass     : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj) 
     831               WRITE(numout,*) ' hfx_in       : ', hfx_in(ji,jj) 
     832               WRITE(numout,*) ' hfx_out      : ', hfx_out(ji,jj) 
     833               WRITE(numout,*) ' dhc          : ', diag_heat_dhc(ji,jj)               
     834               WRITE(numout,*) 
     835               WRITE(numout,*) ' hfx_dyn      : ', hfx_dyn(ji,jj) 
     836               WRITE(numout,*) ' hfx_thd      : ', hfx_thd(ji,jj) 
     837               WRITE(numout,*) ' hfx_res      : ', hfx_res(ji,jj) 
     838               WRITE(numout,*) ' fhtur        : ', fhtur(ji,jj)  
     839               WRITE(numout,*) ' qlead        : ', qlead(ji,jj) * r1_rdtice 
    834840               WRITE(numout,*) 
    835841               WRITE(numout,*) ' - Salt fluxes at bottom interface ***' 
    836842               WRITE(numout,*) ' emp       : ', emp    (ji,jj) 
    837                WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
    838843               WRITE(numout,*) ' sfx       : ', sfx    (ji,jj) 
    839844               WRITE(numout,*) ' sfx_res   : ', sfx_res(ji,jj) 
    840                WRITE(numout,*) ' sfx_mec   : ', sfx_mec(ji,jj) 
    841                WRITE(numout,*) ' - Heat fluxes at bottom interface ***' 
    842                WRITE(numout,*) ' fheat_res : ', fheat_res(ji,jj) 
     845               WRITE(numout,*) ' sfx_bri   : ', sfx_bri(ji,jj) 
     846               WRITE(numout,*) ' sfx_dyn   : ', sfx_dyn(ji,jj) 
    843847               WRITE(numout,*) 
    844848               WRITE(numout,*) ' - Momentum fluxes ' 
    845849               WRITE(numout,*) ' utau      : ', utau(ji,jj)  
    846850               WRITE(numout,*) ' vtau      : ', vtau(ji,jj) 
    847             ENDIF 
     851            ENDIF  
    848852            WRITE(numout,*) ' ' 
    849853            ! 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r4621 r4792  
    5353   USE agrif_lim2_update 
    5454# endif 
     55 
     56#if defined key_bdy  
     57   USE bdyice_lim       ! unstructured open boundary data  (bdy_ice_lim routine) 
     58#endif 
    5559 
    5660   IMPLICIT NONE 
    … …  
    205209                           CALL lim_trp_2      ( kt )      ! Ice transport   ( Advection/diffusion ) 
    206210           IF( ln_limdmp ) CALL lim_dmp_2      ( kt )      ! Ice damping  
     211#if defined key_bdy 
     212                           CALL bdy_ice_lim( kt ) ! bdy ice thermo 
     213#endif 
    207214         END IF 
    208215#if defined key_coupled 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r4607 r4792  
    101101      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 ) 
    102102902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp ) 
    103       WRITE ( numond, namsbc ) 
     103      IF(lwm) WRITE ( numond, namsbc ) 
    104104 
    105105      !                          ! overwrite namelist parameter using CPP key information 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r4368 r4792  
    263263      READ  ( numnam_cfg, namsbc_rnf, IOSTAT = ios, ERR = 902 ) 
    264264902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_rnf in configuration namelist', lwp ) 
    265       WRITE ( numond, namsbc_rnf ) 
     265      IF(lwm) WRITE ( numond, namsbc_rnf ) 
    266266      ! 
    267267      !                                         ! Control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r4147 r4792  
    174174      READ  ( numnam_cfg, namsbc_ssr, IOSTAT = ios, ERR = 902 ) 
    175175902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_ssr in configuration namelist', lwp ) 
    176       WRITE ( numond, namsbc_ssr ) 
     176      IF(lwm) WRITE ( numond, namsbc_ssr ) 
    177177 
    178178      IF(lwp) THEN                 !* control print 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r4292 r4792  
    9090         READ  ( numnam_cfg, namsbc_wave, IOSTAT = ios, ERR = 902 ) 
    9191902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_wave in configuration namelist', lwp ) 
    92          WRITE ( numond, namsbc_wave ) 
     92         IF(lwm) WRITE ( numond, namsbc_wave ) 
    9393         ! 
    9494 

  • branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90

    r4292 r4792  
    7272       READ  ( numnam_cfg, nam_tide, IOSTAT = ios, ERR = 902 ) 
    7373902    IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_tide in configuration namelist', lwp ) 
    74        WRITE ( numond, nam_tide ) 
     74       IF(lwm) WRITE ( numond, nam_tide ) 
    7575       ! 
    7676       nb_harmo=0 
Note: See TracChangeset for help on using the changeset viewer.