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 5609 for trunk/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90 – NEMO

Ignore:
Timestamp:
2015-07-17T17:42:15+02:00 (9 years ago)
Author:
jpaul
Message:

commit changes/bugfix/... for SIREN; see ticket #1580

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/TOOLS/SIREN/src/interp_nearest.f90

    r5037 r5609  
    6969 
    7070      ! local variable 
    71       INTEGER(i4), DIMENSION(4)                :: il_shape 
     71      INTEGER(i4), DIMENSION(4)                  :: il_shape 
     72 
     73      INTEGER(I4), DIMENSION(:,:,:), ALLOCATABLE :: il_detect 
    7274 
    7375      ! loop indices 
     
    8082      il_shape(:)=SHAPE(dd_value) 
    8183 
     84      ALLOCATE(il_detect(il_shape(1),il_shape(2),il_shape(3))) 
    8285      DO jl=1,il_shape(4) 
     86         il_detect(:,:,:)=id_detect(:,:,:) 
    8387         ! loop on vertical level 
    8488         DO jk=1,il_shape(3) 
     
    8690            ! I-J plan 
    8791            CALL interp_nearest__2D(dd_value(:,:,jk,jl),& 
    88             &                       id_detect(:,:,jk),  & 
     92            &                       il_detect(:,:,jk),  & 
    8993            &                       id_rho(jp_I), id_rho(jp_J) )             
    90             IF( ANY(id_detect(:,:,jk)==1) )THEN 
     94            IF( ANY(il_detect(:,:,jk)==1) )THEN 
    9195               ! I direction 
    9296               DO jj=1,il_shape(2) 
    9397                  CALL interp_nearest__1D( dd_value(:,jj,jk,jl),& 
    94                   &                        id_detect(:,jj,jk),  & 
     98                  &                        il_detect(:,jj,jk),  & 
    9599                  &                        id_rho(jp_I) ) 
    96100               ENDDO 
    97                IF( ALL(id_detect(:,:,jk)==0) )THEN 
     101               IF( ALL(il_detect(:,:,jk)==0) )THEN 
    98102                  CYCLE 
    99103               ELSE 
     
    101105                  DO ji=1,il_shape(1) 
    102106                     CALL interp_nearest__1D( dd_value(ji,:,jk,jl),& 
    103                      &                        id_detect(ji,:,jk),  & 
     107                     &                        il_detect(ji,:,jk),  & 
    104108                     &                        id_rho(jp_J) ) 
    105109                  ENDDO 
     
    109113         ENDDO 
    110114      ENDDO 
     115 
     116      id_detect(:,:,:)=il_detect(:,:,:) 
     117      DEALLOCATE(il_detect) 
    111118 
    112119   END SUBROUTINE interp_nearest_fill 
Note: See TracChangeset for help on using the changeset viewer.