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 4827 for branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90 – NEMO

Ignore:
Timestamp:
2014-10-31T12:45:41+01:00 (9 years ago)
Author:
charris
Message:

Some demonstration code changes.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_3841_sbc/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r3625 r4827  
    2222   USE timing          ! Timing 
    2323   USE daymod          ! calendar 
    24    USE fldread         ! read input fields 
     24   USE fld_def 
    2525 
    2626   USE sbc_oce         ! Surface boundary condition: ocean fields 
    … …  
    2828   USE sbcblk_core     ! Surface boundary condition: CORE bulk 
    2929   USE sbccpl 
     30   USE sbcget 
    3031 
    3132   USE ice_kinds_mod 
    … …  
    6263   INTEGER , PARAMETER ::   ji_off = INT ( (jpiglo - nx_global) / 2 ) 
    6364   INTEGER , PARAMETER ::   jj_off = INT ( (jpjglo - ny_global) / 2 ) 
    64  
    65    INTEGER , PARAMETER ::   jpfld   = 13   ! maximum number of files to read  
    66    INTEGER , PARAMETER ::   jp_snow = 1    ! index of snow file 
    67    INTEGER , PARAMETER ::   jp_rain = 2    ! index of rain file 
    68    INTEGER , PARAMETER ::   jp_sblm = 3    ! index of sublimation file 
    69    INTEGER , PARAMETER ::   jp_top1 = 4    ! index of category 1 topmelt file 
    70    INTEGER , PARAMETER ::   jp_top2 = 5    ! index of category 2 topmelt file 
    71    INTEGER , PARAMETER ::   jp_top3 = 6    ! index of category 3 topmelt file 
    72    INTEGER , PARAMETER ::   jp_top4 = 7    ! index of category 4 topmelt file 
    73    INTEGER , PARAMETER ::   jp_top5 = 8    ! index of category 5 topmelt file 
    74    INTEGER , PARAMETER ::   jp_bot1 = 9    ! index of category 1 botmelt file 
    75    INTEGER , PARAMETER ::   jp_bot2 = 10   ! index of category 2 botmelt file 
    76    INTEGER , PARAMETER ::   jp_bot3 = 11   ! index of category 3 botmelt file 
    77    INTEGER , PARAMETER ::   jp_bot4 = 12   ! index of category 4 botmelt file 
    78    INTEGER , PARAMETER ::   jp_bot5 = 13   ! index of category 5 botmelt file 
    79    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
    8065 
    8166   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE ::   png     ! local array used in sbc_cice_ice 
    … …  
    655640      IF( kt == nit000 )  THEN 
    656641         IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 
    657          IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
     642!         IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    658643      ENDIF 
    659644 
    … …  
    705690      !! 
    706691      !!--------------------------------------------------------------------- 
    707       !! ** Method  :   READ monthly flux file in NetCDF files 
     692      !! ** Method  :   Set forcing fields 
    708693      !!       
    709694      !!  snowfall     
    … …  
    716701      !!---------------------------------------------------------------------- 
    717702      !! * Modules used 
    718       USE iom 
    719  
    720       !! * arguments 
     703 
    721704      INTEGER, INTENT( in  ) ::   kt ! ocean time step 
    722705 
    723       INTEGER  ::   ierror             ! return error code 
    724       INTEGER  ::   ifpr               ! dummy loop index 
    725       !! 
    726       CHARACTER(len=100) ::  cn_dir                            !   Root directory for location of CICE forcing files 
    727       TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                 ! array of namelist informations on the fields to read 
    728       TYPE(FLD_N) ::   sn_snow, sn_rain, sn_sblm               ! informations about the fields to be read 
    729       TYPE(FLD_N) ::   sn_top1, sn_top2, sn_top3, sn_top4, sn_top5 
    730       TYPE(FLD_N) ::   sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5  
    731  
    732       !! 
    733       NAMELIST/namsbc_cice/ cn_dir, sn_snow, sn_rain, sn_sblm,   & 
    734          &                          sn_top1, sn_top2, sn_top3, sn_top4, sn_top5,  & 
    735          &                          sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5 
    736       !!--------------------------------------------------------------------- 
    737  
    738       !                                         ! ====================== ! 
    739       IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    740          !                                      ! ====================== ! 
    741          ! set file information (default values) 
    742          cn_dir = './'       ! directory in which the model is executed 
    743  
    744          ! (NB: frequency positive => hours, negative => months) 
    745          !            !    file          ! frequency !  variable    ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
    746          !            !    name          !  (hours)  !   name       !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
    747          sn_snow = FLD_N( 'snowfall_1m'  ,    -1.    ,  'snowfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         )  
    748          sn_rain = FLD_N( 'rainfall_1m'  ,    -1.    ,  'rainfall'  ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         )  
    749          sn_sblm = FLD_N( 'sublim_1m'    ,    -1.    ,  'sublim'    ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    750          sn_top1 = FLD_N( 'topmeltn1_1m' ,    -1.    ,  'topmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    751          sn_top2 = FLD_N( 'topmeltn2_1m' ,    -1.    ,  'topmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    752          sn_top3 = FLD_N( 'topmeltn3_1m' ,    -1.    ,  'topmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    753          sn_top4 = FLD_N( 'topmeltn4_1m' ,    -1.    ,  'topmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    754          sn_top5 = FLD_N( 'topmeltn5_1m' ,    -1.    ,  'topmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    755          sn_bot1 = FLD_N( 'botmeltn1_1m' ,    -1.    ,  'botmeltn1' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    756          sn_bot2 = FLD_N( 'botmeltn2_1m' ,    -1.    ,  'botmeltn2' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    757          sn_bot3 = FLD_N( 'botmeltn3_1m' ,    -1.    ,  'botmeltn3' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    758          sn_bot4 = FLD_N( 'botmeltn4_1m' ,    -1.    ,  'botmeltn4' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    759          sn_bot5 = FLD_N( 'botmeltn5_1m' ,    -1.    ,  'botmeltn5' ,  .true.    , .true.  ,  ' yearly'  , ''       , ''         ) 
    760  
    761 !         REWIND ( numnam )               ! ... at some point might read in from NEMO namelist? 
    762 !         READ   ( numnam, namsbc_cice )  
    763  
    764          ! store namelist information in an array 
    765          slf_i(jp_snow) = sn_snow   ;   slf_i(jp_rain) = sn_rain   ;   slf_i(jp_sblm) = sn_sblm 
    766          slf_i(jp_top1) = sn_top1   ;   slf_i(jp_top2) = sn_top2   ;   slf_i(jp_top3) = sn_top3 
    767          slf_i(jp_top4) = sn_top4   ;   slf_i(jp_top5) = sn_top5   ;   slf_i(jp_bot1) = sn_bot1 
    768          slf_i(jp_bot2) = sn_bot2   ;   slf_i(jp_bot3) = sn_bot3   ;   slf_i(jp_bot4) = sn_bot4 
    769          slf_i(jp_bot5) = sn_bot5 
    770           
    771          ! set sf structure 
    772          ALLOCATE( sf(jpfld), STAT=ierror ) 
    773          IF( ierror > 0 ) THEN 
    774             CALL ctl_stop( 'cice_sbc_force: unable to allocate sf structure' )   ;   RETURN 
    775          ENDIF 
    776  
    777          DO ifpr= 1, jpfld 
    778             ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    779             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    780          END DO 
    781  
    782          ! fill sf with slf_i and control print 
    783          CALL fld_fill( sf, slf_i, cn_dir, 'cice_sbc_force', 'flux formulation for CICE', 'namsbc_cice' ) 
    784          ! 
    785       ENDIF 
    786  
    787       CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the 
    788       !                                          ! input fields at the current time-step 
     706      ! Assume the fluxes have already been obtained somewhere.... 
    789707 
    790708      ! set the fluxes from read fields 
    … …  
    792710      tprecip(:,:) = sf(jp_snow)%fnow(:,:,1)+sf(jp_rain)%fnow(:,:,1) 
    793711! May be better to do this conversion somewhere else 
    794       qla_ice(:,:,1) = -Lsub*sf(jp_sblm)%fnow(:,:,1) 
    795       topmelt(:,:,1) = sf(jp_top1)%fnow(:,:,1) 
    796       topmelt(:,:,2) = sf(jp_top2)%fnow(:,:,1) 
    797       topmelt(:,:,3) = sf(jp_top3)%fnow(:,:,1) 
    798       topmelt(:,:,4) = sf(jp_top4)%fnow(:,:,1) 
    799       topmelt(:,:,5) = sf(jp_top5)%fnow(:,:,1) 
    800       botmelt(:,:,1) = sf(jp_bot1)%fnow(:,:,1) 
    801       botmelt(:,:,2) = sf(jp_bot2)%fnow(:,:,1) 
    802       botmelt(:,:,3) = sf(jp_bot3)%fnow(:,:,1) 
    803       botmelt(:,:,4) = sf(jp_bot4)%fnow(:,:,1) 
    804       botmelt(:,:,5) = sf(jp_bot5)%fnow(:,:,1) 
    805  
    806       ! control print (if less than 100 time-step asked) 
    807       IF( nitend-nit000 <= 100 .AND. lwp ) THEN 
    808          WRITE(numout,*)  
    809          WRITE(numout,*) '        read forcing fluxes for CICE OK' 
    810          CALL FLUSH(numout) 
    811       ENDIF 
     712      qla_ice(:,:,1) = -Lsub*sf(jp_ievp)%fnow(:,:,1) 
     713      topmelt(:,:,:) = sf(jp_topm)%fnow(:,:,:) 
     714      botmelt(:,:,:) = sf(jp_botm)%fnow(:,:,:) 
    812715 
    813716   END SUBROUTINE cice_sbc_force 
Note: See TracChangeset for help on using the changeset viewer.