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 7607 for branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC – NEMO

Ignore:
Timestamp:
2017-01-25T16:37:31+01:00 (7 years ago)
Author:
cetlod
Message:

v3.6 stable : add missing features for CMIP6 exercise, see ticket #1834

Location:
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r5147 r7607  
    6565#if defined key_lim3 || defined key_cice 
    6666   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    67    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
    68    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    69    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     67   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
     68   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K] 
    7069   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7170   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
    … …  
    8382   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3] 
    8483   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3] 
     84#endif 
     85#if defined key_cice 
     86   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K], now namelist parameter for LIM3 
    8587#endif 
    8688#if defined key_lim3 
    … …  
    177179      IF(lwp) THEN 
    178180         WRITE(numout,*) 
     181#if defined key_cice 
    179182         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    180          WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K' 
     183#endif 
     184         WRITE(numout,*) '          thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K' 
    181185         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    182186         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r6323 r7607  
    3939   !                             !!* namelist namsbc_alb 
    4040   INTEGER  ::   nn_ice_alb 
    41    REAL(wp) ::   rn_albice 
     41   REAL(wp) ::   rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt 
    4242 
    4343   !!---------------------------------------------------------------------- 
    … …  
    101101      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    102102 
     103      ralb_sf = rn_alb_sdry ! dry snow 
     104      ralb_sm = rn_alb_smlt ! melting snow 
     105      ralb_if = rn_alb_idry ! bare frozen ice 
     106      ralb_im = rn_alb_imlt ! bare puddled ice  
    103107       
    104108      SELECT CASE ( nn_ice_alb ) 
    … …  
    109113      CASE( 0 ) 
    110114        
    111          ralb_sf = 0.80       ! dry snow 
    112          ralb_sm = 0.65       ! melting snow 
    113          ralb_if = 0.72       ! bare frozen ice 
    114          ralb_im = rn_albice  ! bare puddled ice  
    115           
     115         !ralb_sf = 0.80       ! dry snow 
     116         !ralb_sm = 0.65       ! melting snow 
     117         !ralb_if = 0.72       ! bare frozen ice 
     118         !ralb_im = ...        ! bare puddled ice  
     119 
    116120         !  Computation of ice albedo (free of snow) 
    117121         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
    … …  
    163167      CASE( 1 )  
    164168 
    165          ralb_im = rn_albice  ! bare puddled ice 
     169!        ralb_im = ...        ! bare puddled ice 
    166170! compilation of values from literature 
    167          ralb_sf = 0.85      ! dry snow 
    168          ralb_sm = 0.75      ! melting snow 
    169          ralb_if = 0.60      ! bare frozen ice 
     171!        ralb_sf = 0.85      ! dry snow 
     172!        ralb_sm = 0.75      ! melting snow 
     173!        ralb_if = 0.60      ! bare frozen ice 
    170174! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved 
    171175!         ralb_sf = 0.85       ! dry snow 
    … …  
    248252      !!---------------------------------------------------------------------- 
    249253      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    250       NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice  
     254      NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry , rn_alb_imlt 
    251255      !!---------------------------------------------------------------------- 
    252256      ! 
    … …  
    268272         WRITE(numout,*) '   Namelist namsbc_alb : albedo ' 
    269273         WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb = ', nn_ice_alb 
    270          WRITE(numout,*) '      albedo of bare puddled ice                          rn_albice  = ', rn_albice 
     274         WRITE(numout,*) '      albedo of dry snow                                  rn_alb_sdry = ', rn_alb_sdry 
     275         WRITE(numout,*) '      albedo of melting snow                              rn_alb_smlt = ', rn_alb_smlt 
     276         WRITE(numout,*) '      albedo of dry ice                                   rn_alb_idry = ', rn_alb_idry 
     277         WRITE(numout,*) '      albedo of bare puddled ice                          rn_alb_imlt = ', rn_alb_imlt 
    271278      ENDIF 
    272279      ! 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90

    r5407 r7607  
    113113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s]   
    114114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s]   
     115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting [Kg/m2/s]   
    115116   !! 
    116117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts 
    … …  
    164165         ! 
    165166      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     & 
    166          &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) ) 
     167         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,     & 
     168         &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) ) 
    167169         ! 
    168170      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     & 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7494 r7607  
    4343   USE eosbn2 
    4444   USE sbcrnf   , ONLY : l_rnfcpl 
     45   USE sbcisf   , ONLY : l_isfcpl 
    4546#if defined key_cpl_carbon_cycle 
    4647   USE p4zflx, ONLY : oce_co2 
    … …  
    105106   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
    106107   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
    107    INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     108   INTEGER, PARAMETER ::   jpr_isf    = 43 
     109   INTEGER, PARAMETER ::   jpr_icb    = 44 
     110   INTEGER, PARAMETER ::   jprcv      = 44            ! total number of fields received 
    108111 
    109112   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    … …  
    149152   ! Received from the atmosphere                     ! 
    150153   TYPE(FLD_C) ::   sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau, sn_rcv_dqnsdt, sn_rcv_qsr, sn_rcv_qns, sn_rcv_emp, sn_rcv_rnf 
    151    TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2                         
     154   TYPE(FLD_C) ::   sn_rcv_cal, sn_rcv_iceflx, sn_rcv_co2, sn_rcv_icb, sn_rcv_isf                                
    152155   ! Other namelist parameters                        ! 
    153156   INTEGER     ::   nn_cplmodel            ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 
    … …  
    219222         &                  sn_rcv_w10m, sn_rcv_taumod, sn_rcv_tau  , sn_rcv_dqnsdt, sn_rcv_qsr,      & 
    220223         &                  sn_rcv_qns , sn_rcv_emp   , sn_rcv_rnf  , sn_rcv_cal   , sn_rcv_iceflx,   & 
    221          &                  sn_rcv_co2 , nn_cplmodel  , ln_usecplmask 
     224         &                  sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf, nn_cplmodel  , ln_usecplmask 
    222225      !!--------------------------------------------------------------------- 
    223226      ! 
    … …  
    258261         WRITE(numout,*)'      runoffs                         = ', TRIM(sn_rcv_rnf%cldes   ), ' (', TRIM(sn_rcv_rnf%clcat   ), ')' 
    259262         WRITE(numout,*)'      calving                         = ', TRIM(sn_rcv_cal%cldes   ), ' (', TRIM(sn_rcv_cal%clcat   ), ')' 
     263         WRITE(numout,*)'      iceberg                         = ', TRIM(sn_rcv_icb%cldes   ), ' (', TRIM(sn_rcv_icb%clcat   ), ')' 
     264         WRITE(numout,*)'      ice shelf                       = ', TRIM(sn_rcv_isf%cldes   ), ' (', TRIM(sn_rcv_isf%clcat   ), ')' 
    260265         WRITE(numout,*)'      sea ice heat fluxes             = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 
    261266         WRITE(numout,*)'      atm co2                         = ', TRIM(sn_rcv_co2%cldes   ), ' (', TRIM(sn_rcv_co2%clcat   ), ')' 
    … …  
    397402      END SELECT 
    398403 
    399       !                                                      ! ------------------------- ! 
    400       !                                                      !     Runoffs & Calving     !    
    401       !                                                      ! ------------------------- ! 
     404 
     405      !                                                      ! ---------------------------------------------------- ! 
     406      !                                                      !     Runoffs, Calving, Iceberg, Iceshelf cavities     !    
     407      !                                                      ! ---------------------------------------------------- ! 
    402408      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    403409      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
    … …  
    409415      ENDIF 
    410416      ! 
    411       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     417      srcv(jpr_cal)%clname = 'OCalving'   ;  IF( TRIM( sn_rcv_cal%cldes) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     418      srcv(jpr_isf)%clname = 'OIcshelf'   ;  IF( TRIM( sn_rcv_isf%cldes) == 'coupled' )   srcv(jpr_isf)%laction = .TRUE. 
     419      srcv(jpr_icb)%clname = 'OIceberg'   ;  IF( TRIM( sn_rcv_icb%cldes) == 'coupled' )   srcv(jpr_icb)%laction = .TRUE. 
     420 
     421      IF( srcv(jpr_isf)%laction .AND. nn_isf > 0 ) THEN 
     422         l_isfcpl             = .TRUE.                      ! -> no need to read isf in sbcisf 
     423         IF(lwp) WRITE(numout,*) 
     424         IF(lwp) WRITE(numout,*) '   iceshelf received from oasis ' 
     425      ENDIF 
    412426 
    413427      !                                                      ! ------------------------- ! 
    … …  
    10711085         ENDIF 
    10721086         ! 
     1087         !    
    10731088         !                                                        ! runoffs and calving (added in emp) 
    1074          IF( srcv(jpr_rnf)%laction )     rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1089         IF( srcv(jpr_rnf)%laction )     rnf(:,:)  = frcv(jpr_rnf)%z3(:,:,1) 
    10751090         IF( srcv(jpr_cal)%laction )     zemp(:,:) = zemp(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1091 
     1092         IF( srcv(jpr_icb)%laction )  THEN  
     1093             fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1094             rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runfofs 
     1095         ENDIF 
     1096         IF( srcv(jpr_isf)%laction )  fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
    10761097          
    10771098         IF( ln_mixcpl ) THEN   ;   emp(:,:) = emp(:,:) * xcplmask(:,:,0) + zemp(:,:) * zmsk(:,:) 
    … …  
    10911112            ENDIF 
    10921113         ENDIF 
     1114         ! 
     1115         IF( srcv(jpr_icb)%laction )  zqns(:,:) = zqns(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting 
     1116         ! 
    10931117         IF( ln_mixcpl ) THEN   ;   qns(:,:) = qns(:,:) * xcplmask(:,:,0) + zqns(:,:) * zmsk(:,:) 
    10941118         ELSE                   ;   qns(:,:) =                              zqns(:,:) 
    … …  
    14681492      ENDIF 
    14691493 
     1494      IF( srcv(jpr_icb)%laction )  THEN  
     1495         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1496         rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runoffs 
     1497         CALL iom_put( 'iceberg_cea', frcv(jpr_icb)%z3(:,:,1) ) 
     1498      ENDIF 
     1499      IF( srcv(jpr_isf)%laction )  THEN 
     1500        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1501        CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) ) 
     1502      ENDIF 
     1503 
     1504 
    14701505      IF( ln_mixcpl ) THEN 
    14711506         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
    … …  
    15041539      ENDIF 
    15051540 
     1541 
     1542      IF( srcv(jpr_icb)%laction )  THEN  
     1543         fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 
     1544         rnf(:,:)    = rnf(:,:) + fwficb(:,:)   ! iceberg added to runoffs 
     1545         CALL iom_put( 'iceberg_cea', frcv(jpr_icb)%z3(:,:,1) ) 
     1546      ENDIF 
     1547      IF( srcv(jpr_isf)%laction )  THEN 
     1548        fwfisf(:,:) = - frcv(jpr_isf)%z3(:,:,1)  ! fresh water flux from the isf (fwfisf <0 mean melting)   
     1549        CALL iom_put( 'iceshelf_cea', frcv(jpr_isf)%z3(:,:,1) ) 
     1550      ENDIF 
     1551 
     1552 
    15061553      IF( ln_mixcpl ) THEN 
    15071554         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
    … …  
    15701617         IF( iom_use('hflx_cal_cea') )   CALL iom_put( 'hflx_cal_cea', - frcv(jpr_cal)%z3(:,:,1) * lfus )   ! heat flux from calving 
    15711618      ENDIF 
     1619 
     1620!!chris      
     1621!!    The heat content associated to the ice shelf in removed in the routine sbcisf.F90 
     1622      ! 
     1623      IF( srcv(jpr_icb)%laction )  zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * lfus ! remove heat content associated to iceberg melting 
     1624      ! 
     1625!!      ! 
    15721626 
    15731627#if defined key_lim3       

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r7494 r7607  
    5555   INTEGER,    PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:)     ::  misfkt, misfkb         !:Level of ice shelf base 
    5656 
     57   LOGICAL, PUBLIC ::   l_isfcpl = .false.       ! isf recieved from oasis 
     58 
    5759 
    5860   REAL(wp), PUBLIC, SAVE ::   rcpi   = 2000.0_wp     ! phycst ? 
    … …  
    9496    REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 
    9597    REAL(wp), DIMENSION(:,:  ), POINTER :: zqhcisf2d 
     98    REAL(wp)                            :: zhisf 
     99 
    96100      ! 
    97101      !!--------------------------------------------------------------------- 
    … …  
    142146            misfkt(:,:)    = mikt(:,:)         ! same indice for bg03 et cav => used in isfdiv 
    143147         ELSE IF ((nn_isf == 3) .OR. (nn_isf == 2)) THEN 
    144             ALLOCATE( sf_rnfisf(1), STAT=ierror ) 
    145             ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) ) 
    146             CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     148            IF( .NOT.l_isfcpl ) THEN 
     149               ALLOCATE( sf_rnfisf(1), STAT=ierror ) 
     150               ALLOCATE( sf_rnfisf(1)%fnow(jpi,jpj,1), sf_rnfisf(1)%fdta(jpi,jpj,1,2) ) 
     151               CALL fld_fill( sf_rnfisf, (/ sn_rnfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     152             ENDIF 
    147153 
    148154            !: read effective lenght (BG03) 
    … …  
    185191             
    186192            ! load variable used in fldread (use for temporal interpolation of isf fwf forcing) 
    187             ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror ) 
    188             ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) ) 
    189             ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) ) 
    190             CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
    191             !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' ) 
     193            IF( .NOT.l_isfcpl ) THEN 
     194               ALLOCATE( sf_fwfisf(1), sf_qisf(1), STAT=ierror ) 
     195               ALLOCATE( sf_fwfisf(1)%fnow(jpi,jpj,1), sf_fwfisf(1)%fdta(jpi,jpj,1,2) ) 
     196               ALLOCATE( sf_qisf(1)%fnow(jpi,jpj,1), sf_qisf(1)%fdta(jpi,jpj,1,2) ) 
     197               CALL fld_fill( sf_fwfisf, (/ sn_fwfisf /), cn_dirisf, 'sbc_isf_init', 'read fresh water flux isf data', 'namsbc_isf' ) 
     198               !CALL fld_fill( sf_qisf  , (/ sn_qisf   /), cn_dirisf, 'sbc_isf_init', 'read heat flux isf data'       , 'namsbc_isf' ) 
     199            ENDIF 
    192200         END IF 
    193201          
    … …  
    242250            CALL iom_put('vtbl',vtbl(:,:)) 
    243251            ! compute fwf and heat flux 
    244             CALL sbc_isf_cav (kt) 
     252            IF( .NOT.l_isfcpl ) THEN    ;   CALL sbc_isf_cav (kt) 
     253            ELSE                        ;   qisf(:,:)  = fwfisf(:,:) * lfusisf              ! heat        flux 
     254            ENDIF 
    245255 
    246256         ELSE IF (nn_isf == 2) THEN 
    … …  
    251261         ELSE IF (nn_isf == 3) THEN 
    252262            ! specified runoff in depth (Mathiot et al., XXXX in preparation) 
    253             CALL fld_read ( kt, nn_fsbc, sf_rnfisf   ) 
    254             fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
     263            IF( .NOT.l_isfcpl ) THEN 
     264               CALL fld_read ( kt, nn_fsbc, sf_rnfisf   ) 
     265               fwfisf(:,:) = - sf_rnfisf(1)%fnow(:,:,1)         ! fresh water flux from the isf (fwfisf <0 mean melting)  
     266            ENDIF 
    255267            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    256268            stbl(:,:)   = soce 
    … …  
    258270         ELSE IF (nn_isf == 4) THEN 
    259271            ! specified fwf and heat flux forcing beneath the ice shelf 
    260             CALL fld_read ( kt, nn_fsbc, sf_fwfisf   ) 
    261             !CALL fld_read ( kt, nn_fsbc, sf_qisf   ) 
    262             fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
     272            IF( .NOT.l_isfcpl ) THEN 
     273               CALL fld_read ( kt, nn_fsbc, sf_fwfisf   ) 
     274               !CALL fld_read ( kt, nn_fsbc, sf_qisf   ) 
     275               fwfisf(:,:) = sf_fwfisf(1)%fnow(:,:,1)            ! fwf 
     276            ENDIF 
    263277            qisf(:,:)   = fwfisf(:,:) * lfusisf              ! heat        flux 
    264278            !qisf(:,:)   = sf_qisf(1)%fnow(:,:,1)              ! heat flux 
    … …  
    288302         CALL lbc_lnk(qisf(:,:)     ,'T',1.) 
    289303 
    290 !============================================================================================================================================= 
    291          IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 
     304         ! Diagnostics 
     305         IF( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN 
     306            ! 
    292307            CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
    293308            CALL wrk_alloc( jpi,jpj,     zqhcisf2d                        ) 
    294  
     309            ! 
    295310            zfwfisf3d(:,:,:) = 0.0_wp                         ! 3d ice shelf melting (kg/m2/s) 
    296311            zqhcisf3d(:,:,:) = 0.0_wp                         ! 3d heat content flux (W/m2) 
    297312            zqlatisf3d(:,:,:)= 0.0_wp                         ! 3d ice shelf melting latent heat flux (W/m2) 
    298313            zqhcisf2d(:,:)   = fwfisf(:,:) * zt_frz * rcp     ! 2d heat content flux (W/m2) 
    299  
     314            ! 
    300315            DO jj = 1,jpj 
    301316               DO ji = 1,jpi 
    … …  
    303318                  ikb = misfkb(ji,jj) 
    304319                  DO jk = ikt, ikb - 1 
    305                      zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
    306                      zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
    307                      zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     320                     zhisf = r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     321                     zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf(ji,jj)    * zhisf 
     322                     zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * zhisf 
     323                     zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf(ji,jj)      * zhisf 
    308324                  END DO 
    309                   zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 
    310                   zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 
    311                   zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 
     325                  jk = ikb 
     326                  zhisf = r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 
     327                  zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf   (ji,jj) * zhisf * ralpha(ji,jj)  
     328                  zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * zhisf * ralpha(ji,jj) 
     329                  zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf     (ji,jj) * zhisf * ralpha(ji,jj) 
    312330               END DO 
    313331            END DO 
    314  
    315             CALL iom_put('fwfisf3d' , zfwfisf3d (:,:,:)) 
    316             CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:)) 
    317             CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:)) 
    318             CALL iom_put('qhcisf'   , zqhcisf2d (:,:  )) 
    319  
     332            ! 
     333            CALL iom_put( 'fwfisf3d' , zfwfisf3d (:,:,:) ) 
     334            CALL iom_put( 'qlatisf3d', zqlatisf3d(:,:,:) ) 
     335            CALL iom_put( 'qhcisf3d' , zqhcisf3d (:,:,:) ) 
     336            CALL iom_put( 'qhcisf'   , zqhcisf2d (:,:  ) ) 
     337            ! 
    320338            CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 
    321339            CALL wrk_dealloc( jpi,jpj,     zqhcisf2d                        ) 
     340            ! 
    322341         END IF 
    323 !============================================================================================================================================= 
    324  
     342         ! 
    325343         IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    ! 
    326344            IF( ln_rstart .AND.    &                     ! Restart: read in restart file 

  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r6204 r7607  
    180180      ENDIF 
    181181 
    182 9200  FORMAT('it:', i8, ' iter:', i4, ' r: ',e16.10, ' b: ',e16.10 ) 
    183 9300  FORMAT(' it :', i8, ' ssh2: ', e16.10, ' Umax: ',e16.10,' Smin: ',e16.10) 
     1829200  FORMAT('it:', i8, ' iter:', i4, ' r: ',d23.16, ' b: ',d23.16 ) 
     1839300  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16) 
    184184      ! 
    185185   END SUBROUTINE stp_ctl 
Note: See TracChangeset for help on using the changeset viewer.