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 for branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90 – NEMO

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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.