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

Changeset 3381


Ignore:
Timestamp:
2012-05-04T09:26:12+02:00 (12 years ago)
Author:
sga
Message:

NEMO branch dev_r3337_NOCS10_ICB: Changes to allow branch to compile with key_agrif. Not yet complete.

Along the way replace unnecessary POINTER declarations

Location:
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90

    r3371 r3381  
    4848 
    4949   TYPE, PUBLIC ::   icebergs_gridded   !: various icebergs properties on model grid 
    50       REAL(wp), DIMENSION(:,:)  , POINTER ::   calving       => NULL()   ! Calving mass rate  (into stored ice)         [kg/s] 
    51       REAL(wp), DIMENSION(:,:)  , POINTER ::   calving_hflx  => NULL()   ! Calving heat flux [heat content of calving]  [W/m2] 
    52       REAL(wp), DIMENSION(:,:)  , POINTER ::   floating_melt => NULL()   ! Net melting rate to icebergs + bits      [kg/s/m^2] 
    53       INTEGER , DIMENSION(:,:)  , POINTER ::   maxclass      => NULL()   ! maximum class number at calving source point 
    54       REAL(wp), DIMENSION(:,:)  , POINTER ::   tmp           => NULL()   ! Temporary work space 
    55       REAL(wp), DIMENSION(:,:,:), POINTER ::   stored_ice    => NULL()   ! Accumulated ice mass flux at calving locations [kg] 
    56       REAL(wp), DIMENSION(:,:)  , POINTER ::   stored_heat   => NULL()   ! Heat content of stored ice                      [J] 
     50      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   calving         ! Calving mass rate  (into stored ice)         [kg/s] 
     51      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   calving_hflx    ! Calving heat flux [heat content of calving]  [W/m2] 
     52      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   floating_melt   ! Net melting rate to icebergs + bits      [kg/s/m^2] 
     53      INTEGER , DIMENSION(:,:)  , ALLOCATABLE ::   maxclass        ! maximum class number at calving source point 
     54      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   tmp             ! Temporary work space 
     55      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   stored_ice      ! Accumulated ice mass flux at calving locations [kg] 
     56      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   stored_heat     ! Heat content of stored ice                      [J] 
    5757   END TYPE icebergs_gridded 
    5858 
     
    7979 
    8080   !                                                             !!! parameters controlling iceberg characteristics and modelling 
    81    REAL(wp)                        ::   berg_dt                   !: Time-step between iceberg CALLs (should make adaptive?) 
    82    INTEGER                         ::   current_year              !:  
    83    REAL(wp)                        ::   current_yearday           !: 1.00-365.99 
    84    REAL(wp), DIMENSION(:), POINTER ::   first_width, first_length !:  
    85    LOGICAL                         ::   l_restarted_bergs=.FALSE.  ! Indicate whether we read state from a restart or not 
     81   REAL(wp)                            ::   berg_dt                   !: Time-step between iceberg CALLs (should make adaptive?) 
     82   INTEGER                             ::   current_year              !:  
     83   REAL(wp)                            ::   current_yearday           !: 1.00-365.99 
     84   REAL(wp), DIMENSION(:), ALLOCATABLE ::   first_width, first_length !:  
     85   LOGICAL                             ::   l_restarted_bergs=.FALSE.  ! Indicate whether we read state from a restart or not 
    8686   !                                                               ! arbitrary numbers for diawri entry 
    8787   REAL(wp), DIMENSION(nclasses), PUBLIC ::   class_num=(/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 /) 
     
    140140 
    141141   ! Single instance of an icebergs type initialised in icebergs_init and updated in icebergs_run 
    142    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   src_calving, src_calving_hflx    !: ??? 
    143    INTEGER , PUBLIC             , SAVE                     ::   numicb                           !: ??? 
    144    INTEGER , PUBLIC             , SAVE, DIMENSION(nkounts) ::   num_bergs                        !: ??? 
    145    INTEGER , PUBLIC             , SAVE                     ::   nicbdi, nicbei, nicbdj, nicbej   !: ??? 
    146    REAL(wp), PUBLIC             , SAVE                     ::   ricb_left, ricb_right            !: ??? 
    147    INTEGER , PUBLIC             , SAVE                     ::   nicbpack                         !: ??? 
    148    INTEGER , PUBLIC             , SAVE                     ::   nktberg, nknberg                 !: ??? 
    149    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldpts                       !: ??? 
    150    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbflddest                      !: ??? 
    151    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldproc                      !: ??? 
    152  
    153    TYPE(FLD), ALLOCATABLE, PUBLIC     , DIMENSION(:)       ::   sf_icb   !: structure: file information, fields read 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::   src_calving, src_calving_hflx    !: accumulate input ice 
     143   INTEGER , PUBLIC             , SAVE                     ::   numicb                           !: iceberg IO 
     144   INTEGER , PUBLIC             , SAVE, DIMENSION(nkounts) ::   num_bergs                        !: iceberg counter 
     145   INTEGER , PUBLIC             , SAVE                     ::   nicbdi, nicbei, nicbdj, nicbej   !: processor bounds 
     146   REAL(wp), PUBLIC             , SAVE                     ::   ricb_left, ricb_right            !: cyclical bounds 
     147   INTEGER , PUBLIC             , SAVE                     ::   nicbpack                         !: packing integer 
     148   INTEGER , PUBLIC             , SAVE                     ::   nktberg, nknberg                 !: helpers 
     149   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldpts                       !: nfold packed points 
     150   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbflddest                      !: nfold destination proc 
     151   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldproc                      !: nfold destination proc 
     152 
     153   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: griddata                           !: work array for icbrst 
     154 
     155   TYPE(FLD), PUBLIC, ALLOCATABLE     , DIMENSION(:)       ::   sf_icb   !: structure: file information, fields read 
    154156 
    155157   !!---------------------------------------------------------------------- 
     
    191193      icb_alloc = icb_alloc + ill 
    192194 
     195      ALLOCATE( griddata(jpi,jpj,1), STAT=ill ) 
     196      icb_alloc = icb_alloc + ill 
     197 
    193198      IF( lk_mpp        )   CALL mpp_sum ( icb_alloc ) 
    194199      IF( icb_alloc > 0 )   CALL ctl_warn('icb_alloc: allocation of arrays failed') 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90

    r3379 r3381  
    3737   PUBLIC   icb_dia_income    ! routine called in icbclv.F90 module 
    3838 
    39    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   berg_melt    => NULL()   ! Melting+erosion rate of icebergs     [kg/s/m2] 
    40    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   buoy_melt    => NULL()   ! Buoyancy component of melting rate   [kg/s/m2] 
    41    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   eros_melt    => NULL()   ! Erosion component of melting rate    [kg/s/m2] 
    42    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   conv_melt    => NULL()   ! Convective component of melting rate [kg/s/m2] 
    43    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   bits_src     => NULL()   ! Mass flux from berg erosion into bergy bits [kg/s/m2] 
    44    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   bits_melt    => NULL()   ! Melting rate of bergy bits           [kg/s/m2] 
    45    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   bits_mass    => NULL()   ! Mass distribution of bergy bits      [kg/s/m2] 
    46    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   virtual_area => NULL()   ! Virtual surface coverage by icebergs [m2] 
    47    REAL(wp), DIMENSION(:,:)  , POINTER, PUBLIC  ::   berg_mass    => NULL()   ! Mass distribution                    [kg/m2] 
    48    REAL(wp), DIMENSION(:,:,:), POINTER, PUBLIC  ::   real_calving => NULL()   ! Calving rate into iceberg class at 
     39   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_melt       ! Melting+erosion rate of icebergs     [kg/s/m2] 
     40   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   buoy_melt       ! Buoyancy component of melting rate   [kg/s/m2] 
     41   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   eros_melt       ! Erosion component of melting rate    [kg/s/m2] 
     42   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   conv_melt       ! Convective component of melting rate [kg/s/m2] 
     43   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_src        ! Mass flux from berg erosion into bergy bits [kg/s/m2] 
     44   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_melt       ! Melting rate of bergy bits           [kg/s/m2] 
     45   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   bits_mass       ! Mass distribution of bergy bits      [kg/s/m2] 
     46   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   virtual_area    ! Virtual surface coverage by icebergs [m2] 
     47   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE, PUBLIC  ::   berg_mass       ! Mass distribution                    [kg/m2] 
     48   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PUBLIC  ::   real_calving    ! Calving rate into iceberg class at 
    4949   !                                                                          ! calving locations                    [kg/s] 
    5050    
    51    REAL(wp), DIMENSION(:,:)  , POINTER ::   tmpc         => NULL()   ! Temporary work space 
    52    REAL(wp), DIMENSION(:)    , POINTER ::   rsumbuf      => NULL()   ! Temporary work space to reduce mpp exchanges 
    53    INTEGER , DIMENSION(:)    , POINTER ::   nsumbuf      => NULL()   ! Temporary work space to reduce mpp exchanges 
     51   REAL(wp), DIMENSION(:,:)  , ALLOCATABLE ::   tmpc                     ! Temporary work space 
     52   REAL(wp), DIMENSION(:)    , ALLOCATABLE ::   rsumbuf                  ! Temporary work space to reduce mpp exchanges 
     53   INTEGER , DIMENSION(:)    , ALLOCATABLE ::   nsumbuf                  ! Temporary work space to reduce mpp exchanges 
    5454 
    5555   REAL(wp)                      ::  berg_melt_net 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90

    r3379 r3381  
    158158         ! update actual position 
    159159         pt%lon  = icb_utl_bilin_x(glamt, pt%xi, pt%yj ) 
    160          pt%lat  = icb_utl_bilin(gphit, pt%xi, pt%yj, 'T', 0, 0 ) 
     160         pt%lat  = icb_utl_bilin(gphit, pt%xi, pt%yj, 'T' ) 
    161161 
    162162         berg => berg%next                         ! switch to the next berg 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90

    r3379 r3381  
    308308               localpt%xi = REAL( mig(ji), wp ) 
    309309               localpt%yj = REAL( mjg(jj), wp ) 
    310                localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T', 0, 0 ) 
    311                localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T', 0, 0 ) 
     310               localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T' ) 
     311               localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T' ) 
    312312               localpt%mass      = rn_initial_mass     (iberg) 
    313313               localpt%thickness = rn_initial_thickness(iberg) 
     
    315315               localpt%length = first_length(iberg) 
    316316               localpt%year = iyr 
    317                localpt%day = FLOAT(iday)+(FLOAT(ihr)+FLOAT(imin)/60._wp)/24._wp 
     317               localpt%day = REAL(iday,wp)+(REAL(ihr,wp)+REAL(imin,wp)/60._wp)/24._wp 
    318318               localpt%mass_of_bits = 0._wp 
    319319               localpt%heat_density = 0._wp 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90

    r3379 r3381  
    3838   INTEGER ::   nret, ncid, nc_dim 
    3939    
    40    INTEGER,  DIMENSION(3)              :: nstrt3, nlngth3 
    41    REAL(wp), DIMENSION(:,:,:), POINTER :: griddata => NULL()    ! need 2d array to read in with 
     40   INTEGER,  DIMENSION(3)                  :: nstrt3, nlngth3 
    4241 
    4342   !!---------------------------------------------------------------------- 
     
    7069      TYPE(point)                  ::   localpt   ! NOT a pointer but an actual local variable 
    7170      !!---------------------------------------------------------------------- 
    72  
    73       IF( .NOT. ASSOCIATED(griddata) ) ALLOCATE( griddata(jpi,jpj,1) ) 
    7471 
    7572      ! Find a restart file 
     
    236233      !!---------------------------------------------------------------------- 
    237234 
    238       IF( .NOT. ASSOCIATED(griddata) ) ALLOCATE( griddata(jpi,jpj,1) ) 
    239  
    240235      IF( lk_mpp ) THEN 
    241236         WRITE(cl_filename,'("icebergs_",I8.8,"_restart_",I4.4,".nc")') kt, narea-1 
  • branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90

    r3379 r3381  
    2424#if defined key_lim2 
    2525   USE ice_2,         ONLY: u_ice, v_ice   ! LIM-2 ice velocities  (CAUTION in C-grid do not use key_vp option) 
    26    USE ice_2,         ONLY: hi => hicif    ! LIM-2 ice thickness 
     26   USE ice_2,         ONLY: hicif          ! LIM-2 ice thickness 
    2727#elif defined key_lim3 
    2828   USE ice,           ONLY: u_ice, v_ice   ! LIM-3 variables  (always in C-grid) 
     
    137137      pe2 = icb_utl_bilin_e( e2t, e2u, e2v, e2f, pi, pj ) 
    138138      ! 
    139       puo  = icb_utl_bilin( uo_e, pi, pj, 'U', 1, 1 )             ! ocean velocities 
    140       pvo  = icb_utl_bilin( vo_e, pi, pj, 'V', 1, 1 ) 
    141       psst = icb_utl_bilin( sst_m, pi, pj, 'T', 0, 0 )            ! SST 
    142       pcn  = icb_utl_bilin( fr_i , pi, pj, 'T', 0, 0 )            ! ice concentration 
    143       pff  = icb_utl_bilin( ff_e , pi, pj, 'F', 1, 1 )            ! Coriolis parameter 
    144       ! 
    145       pua  = icb_utl_bilin( ua_e , pi, pj, 'U', 1, 1 )            ! 10m wind 
    146       pva  = icb_utl_bilin( va_e , pi, pj, 'V', 1, 1 )            ! here (ua,va) are stress => rough conversion from stress to speed 
     139      puo  = icb_utl_bilin_h( uo_e, pi, pj, 'U' )             ! ocean velocities 
     140      pvo  = icb_utl_bilin_h( vo_e, pi, pj, 'V' ) 
     141      psst = icb_utl_bilin( sst_m, pi, pj, 'T' )            ! SST 
     142      pcn  = icb_utl_bilin( fr_i , pi, pj, 'T' )            ! ice concentration 
     143      pff  = icb_utl_bilin_h( ff_e , pi, pj, 'F' )            ! Coriolis parameter 
     144      ! 
     145      pua  = icb_utl_bilin_h( ua_e , pi, pj, 'U' )            ! 10m wind 
     146      pva  = icb_utl_bilin_h( va_e , pi, pj, 'V' )            ! here (ua,va) are stress => rough conversion from stress to speed 
    147147      zcd  = 1.22_wp * 1.5e-3_wp                                  ! air density * drag coefficient 
    148148      zmod = 1._wp / MAX(  1.e-20, SQRT(  zcd * SQRT( pua*pua + pva*pva)  )  ) 
     
    151151 
    152152#if defined key_lim2 || defined key_lim3 
    153       pui = icb_utl_bilin( ui_e, pi, pj, 'U', 1, 1 )              ! sea-ice velocities 
    154       pvi = icb_utl_bilin( vi_e, pi, pj, 'V', 1, 1 ) 
    155       phi = icb_utl_bilin( hi  , pi, pj, 'T', 0, 0 )              ! ice thickness 
     153      pui = icb_utl_bilin_h( ui_e, pi, pj, 'U' )              ! sea-ice velocities 
     154      pvi = icb_utl_bilin_h( vi_e, pi, pj, 'V' ) 
     155      phi = icb_utl_bilin(hicif, pi, pj, 'T' )              ! ice thickness 
    156156#else 
    157157      pui = 0._wp 
     
    161161 
    162162      ! Estimate SSH gradient in i- and j-direction (centred evaluation) 
    163       pssh_i = ( icb_utl_bilin( ssh_e, pi+0.1_wp, pj, 'T', 1, 1 ) -   & 
    164           &      icb_utl_bilin( ssh_e, pi-0.1_wp, pj, 'T', 1, 1 )  ) / ( 0.2_wp * pe1 ) 
    165       pssh_j = ( icb_utl_bilin( ssh_e, pi, pj+0.1_wp, 'T', 1, 1 ) -   & 
    166           &      icb_utl_bilin( ssh_e, pi, pj-0.1_wp, 'T', 1, 1 )  ) / ( 0.2_wp * pe2 ) 
     163      pssh_i = ( icb_utl_bilin_h( ssh_e, pi+0.1_wp, pj, 'T' ) -   & 
     164          &      icb_utl_bilin_h( ssh_e, pi-0.1_wp, pj, 'T' )  ) / ( 0.2_wp * pe1 ) 
     165      pssh_j = ( icb_utl_bilin_h( ssh_e, pi, pj+0.1_wp, 'T' ) -   & 
     166          &      icb_utl_bilin_h( ssh_e, pi, pj-0.1_wp, 'T' )  ) / ( 0.2_wp * pe2 ) 
    167167      ! 
    168168   END SUBROUTINE icb_utl_interp 
    169169 
    170170 
    171    REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type, kdi, kdj ) 
     171   REAL(wp) FUNCTION icb_utl_bilin_h( pfld, pi, pj, cd_type ) 
    172172      !!---------------------------------------------------------------------- 
    173173      !!                  ***  FUNCTION icb_utl_bilin  *** 
    174174      !! 
    175175      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
     176      !!                this version deals with extra halo points 
    176177      !! 
    177178      !!       !!gm  CAUTION an optional argument should be added to handle 
     
    179180      !! 
    180181      !!---------------------------------------------------------------------- 
    181       INTEGER                                         , INTENT(in) ::   kdi, kdj  ! extra halo on grid 
    182       REAL(wp), DIMENSION(1-kdi:jpi+kdi,1-kdj:jpj+kdj), INTENT(in) ::   pfld      ! field to be interpolated 
    183       REAL(wp)                                        , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
    184       CHARACTER(len=1)                                , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
     182      REAL(wp), DIMENSION(0:jpi+1,0:jpj+1), INTENT(in) ::   pfld      ! field to be interpolated 
     183      REAL(wp)                            , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
     184      CHARACTER(len=1)                    , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
     185      ! 
     186      INTEGER  ::   ii, ij   ! local integer 
     187      REAL(wp) ::   zi, zj   ! local real 
     188      !!---------------------------------------------------------------------- 
     189      ! 
     190      SELECT CASE ( cd_type ) 
     191         CASE ( 'T' ) 
     192            ! note that here there is no +0.5 added 
     193            ! since we're looking for four T points containing quadrant we're in of  
     194            ! current T cell 
     195            ii = INT( pi     ) 
     196            ij = INT( pj      )    ! T-point 
     197            zi = pi - REAL(ii,wp) 
     198            zj = pj - REAL(ij,wp) 
     199         CASE ( 'U' ) 
     200            ii = INT( pi-0.5 ) 
     201            ij = INT( pj      )    ! U-point 
     202            zi = pi - 0.5 - REAL(ii,wp) 
     203            zj = pj - REAL(ij,wp) 
     204         CASE ( 'V' ) 
     205            ii = INT( pi     ) 
     206            ij = INT( pj -0.5 )    ! V-point 
     207            zi = pi - REAL(ii,wp) 
     208            zj = pj - 0.5 - REAL(ij,wp) 
     209         CASE ( 'F' ) 
     210            ii = INT( pi-0.5 ) 
     211            ij = INT( pj -0.5 )    ! F-point 
     212            zi = pi - 0.5 - REAL(ii,wp) 
     213            zj = pj - 0.5 - REAL(ij,wp) 
     214      END SELECT 
     215      ! 
     216      ! find position in this processor 
     217      ii = mi1( ii ) 
     218      ij = mj1( ij ) 
     219      ! 
     220      icb_utl_bilin_h = ( pfld(ii,ij  ) * (1.-zi) + pfld(ii+1,ij  ) * zi ) * (1.-zj)   & 
     221         &            + ( pfld(ii,ij+1) * (1.-zi) + pfld(ii+1,ij+1) * zi ) *     zj 
     222      ! 
     223   END FUNCTION icb_utl_bilin_h 
     224 
     225 
     226   REAL(wp) FUNCTION icb_utl_bilin( pfld, pi, pj, cd_type ) 
     227      !!---------------------------------------------------------------------- 
     228      !!                  ***  FUNCTION icb_utl_bilin  *** 
     229      !! 
     230      !! ** Purpose :   bilinear interpolation at berg location depending on the grid-point type 
     231      !! 
     232      !!       !!gm  CAUTION an optional argument should be added to handle 
     233      !!             the slip/no-slip conditions  ==>>> to be done later 
     234      !! 
     235      !!---------------------------------------------------------------------- 
     236      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pfld      ! field to be interpolated 
     237      REAL(wp)                    , INTENT(in) ::   pi, pj    ! targeted coordinates in (i,j) referential 
     238      CHARACTER(len=1)            , INTENT(in) ::   cd_type   ! type of pfld array grid-points: = T , U , V or F points 
    185239      ! 
    186240      INTEGER  ::   ii, ij   ! local integer 
     
    407461      ! 
    408462      IF( ASSOCIATED( first_berg ) ) THEN 
    409 !        last = last_berg() 
    410          last=>first_berg 
     463         last => first_berg 
    411464         DO WHILE (ASSOCIATED(last%next)) 
    412             last=>last%next 
     465            last => last%next 
    413466         ENDDO 
    414467         newberg%prev => last 
     
    438491      !!---------------------------------------------------------------------- 
    439492      ! 
    440       icb_utl_yearday = FLOAT( SUM( imonths(1:kmon) ) ) 
    441       icb_utl_yearday = icb_utl_yearday + FLOAT(kday-1) + (FLOAT(khr) + (FLOAT(kmin) + FLOAT(ksec)/60.)/60.)/24. 
     493      icb_utl_yearday = REAL( SUM( imonths(1:kmon) ), wp ) 
     494      icb_utl_yearday = icb_utl_yearday + REAL(kday-1,wp) + (REAL(khr,wp) + (REAL(kmin,wp) + REAL(ksec,wp)/60.)/60.)/24. 
    442495      ! 
    443496   END FUNCTION icb_utl_yearday 
Note: See TracChangeset for help on using the changeset viewer.