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/SBC/sbcisf.F90 – 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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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 
Note: See TracChangeset for help on using the changeset viewer.