Ignore:
Timestamp:
2019-02-27T14:55:54+01:00 (19 months ago)
Author:
rblod
Message:

Update agrif library and conv see ticket #2129

File:
1 edited

Legend:

Unmodified
Added
Removed
  • vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbc.F90

    r10087 r10725  
    3232! 
    3333    implicit none 
    34     REAL,DIMENSION(:),ALLOCATABLE :: parray_temp 
    3534! 
    3635contains 
     
    6261    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border 
    6362                                                !    with the root grid 
    64     real(kind=8), dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids 
    65     real(kind=8), dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids 
     63    real, dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids 
     64    real, dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids 
    6665! 
    6766    call PreProcessToInterpOrUpdate( parent,   child,       & 
     
    146145    INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2) 
    147146    INTEGER, DIMENSION(nbdim)   :: loctab_Child         !< Indicates if the child grid has a common border with the root grid 
    148     REAL(kind=8)   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids 
    149     REAL(kind=8)   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids 
     147    REAL   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids 
     148    REAL   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids 
    150149    INTEGER                             :: nbdim        !< Number of dimensions of the grid variable 
    151150    procedure()                         :: procname     !< Data recovery procedure 
     
    160159    INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated 
    161160    INTEGER,DIMENSION(nbdim)            :: coords 
    162     INTEGER                             :: i, nb, ndir,j,k,l 
     161    INTEGER                             :: i, nb, ndir 
    163162    INTEGER                             :: n, sizetab 
    164163    INTEGER                             :: ibeg, iend 
    165164    INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2 
    166165    REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t) 
    167     INTEGER :: isize 
    168     INTEGER :: kindex_2d(2,nbdim) 
    169  
    170166#if defined AGRIF_MPI 
    171167! 
     
    192188    END WHERE 
    193189! 
    194 !   call Agrif_get_var_global_bounds(child,lubglob,nbdim) 
    195     lubglob = child%lubglob(1:nbdim,:) 
     190    call Agrif_get_var_global_bounds(child,lubglob,nbdim) 
    196191! 
    197192    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) 
     
    199194    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2)) 
    200195    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2)) 
    201     
    202196! 
    203197    do nb = 1,nbdim 
     
    273267                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 
    274268! 
    275  
    276269                    call Agrif_InterpnD(type_interp, parent, child,             & 
    277270                                        ptres(1:nbdim,1,ndir,nb),               & 
     
    326319        do nb = 1,nbdim 
    327320            do ndir = 1,2 
    328                 kindex_2d(ndir,nb) = kindex 
    329                 if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 
     321                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 
    330322                    Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim) 
    331323                endif 
     
    333325        enddo 
    334326! 
     327    endif 
     328! 
    335329    do nb = 1,nbdim 
    336330    do ndir = 1,2 
    337331        if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 
    338  
    339          do i=1,nbdim 
    340          if (ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir)) then 
    341             print *,'problem ptres2 childarray 1 ',ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir) 
    342             stop 
    343          endif 
    344          if (ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir)) then 
    345             print *,'problem ptres2 childarray 2 ',ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir) 
    346           stop 
    347          endif 
    348          enddo 
    349  
    350332            select case(nbdim) 
    351333            case(1) 
     
    364346                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir) 
    365347            case(3) 
    366  
    367348                i1 = child % childarray(1,1,2,nb,ndir) 
    368349                i2 = child % childarray(1,2,2,nb,ndir) 
     
    372353                k2 = child % childarray(3,2,2,nb,ndir) 
    373354 
    374                call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 
    375  
     355                call procname(parray3(i1:i2,j1:j2,k1:k2),                   & 
     356                              i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 
    376357            case(4) 
    377358                i1 = child % childarray(1,1,2,nb,ndir) 
     
    384365                l2 = child % childarray(4,2,2,nb,ndir) 
    385366 
    386                 call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2,l1,l2,.FALSE.,coords(nb),ndir) 
    387  
     367                call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             & 
     368                              i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir) 
    388369            case(5) 
    389370                i1 = child % childarray(1,1,2,nb,ndir) 
     
    420401    enddo 
    421402    enddo 
    422  
    423     else 
    424  
    425     do nb = 1,nbdim 
    426     do ndir = 1,2 
    427         if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 
    428             select case(nbdim) 
    429             case(1) 
    430                 i1 = child % childarray(1,1,2,nb,ndir) 
    431                 i2 = child % childarray(1,2,2,nb,ndir) 
    432  
    433                 call procname(parray1(i1:i2),                               & 
    434                               i1,i2, .FALSE.,coords(nb),ndir) 
    435             case(2) 
    436                 i1 = child % childarray(1,1,2,nb,ndir) 
    437                 i2 = child % childarray(1,2,2,nb,ndir) 
    438                 j1 = child % childarray(2,1,2,nb,ndir) 
    439                 j2 = child % childarray(2,2,2,nb,ndir) 
    440  
    441                 call procname(parray2(i1:i2,j1:j2),                         & 
    442                               i1,i2,j1,j2, .FALSE.,coords(nb),ndir) 
    443             case(3) 
    444  
    445                 i1 = child % childarray(1,1,2,nb,ndir) 
    446                 i2 = child % childarray(1,2,2,nb,ndir) 
    447                 j1 = child % childarray(2,1,2,nb,ndir) 
    448                 j2 = child % childarray(2,2,2,nb,ndir) 
    449                 k1 = child % childarray(3,1,2,nb,ndir) 
    450                 k2 = child % childarray(3,2,2,nb,ndir) 
    451  
    452                 call procname(parray3(i1:i2,j1:j2,k1:k2),                   & 
    453                               i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 
    454  
    455             case(4) 
    456                 i1 = child % childarray(1,1,2,nb,ndir) 
    457                 i2 = child % childarray(1,2,2,nb,ndir) 
    458                 j1 = child % childarray(2,1,2,nb,ndir) 
    459                 j2 = child % childarray(2,2,2,nb,ndir) 
    460                 k1 = child % childarray(3,1,2,nb,ndir) 
    461                 k2 = child % childarray(3,2,2,nb,ndir) 
    462                 l1 = child % childarray(4,1,2,nb,ndir) 
    463                 l2 = child % childarray(4,2,2,nb,ndir) 
    464  
    465                 call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             & 
    466                               i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir) 
    467  
    468             case(5) 
    469                 i1 = child % childarray(1,1,2,nb,ndir) 
    470                 i2 = child % childarray(1,2,2,nb,ndir) 
    471                 j1 = child % childarray(2,1,2,nb,ndir) 
    472                 j2 = child % childarray(2,2,2,nb,ndir) 
    473                 k1 = child % childarray(3,1,2,nb,ndir) 
    474                 k2 = child % childarray(3,2,2,nb,ndir) 
    475                 l1 = child % childarray(4,1,2,nb,ndir) 
    476                 l2 = child % childarray(4,2,2,nb,ndir) 
    477                 m1 = child % childarray(5,1,2,nb,ndir) 
    478                 m2 = child % childarray(5,2,2,nb,ndir) 
    479  
    480                 call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2),       & 
    481                               i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir) 
    482             case(6) 
    483                 i1 = child % childarray(1,1,2,nb,ndir) 
    484                 i2 = child % childarray(1,2,2,nb,ndir) 
    485                 j1 = child % childarray(2,1,2,nb,ndir) 
    486                 j2 = child % childarray(2,2,2,nb,ndir) 
    487                 k1 = child % childarray(3,1,2,nb,ndir) 
    488                 k2 = child % childarray(3,2,2,nb,ndir) 
    489                 l1 = child % childarray(4,1,2,nb,ndir) 
    490                 l2 = child % childarray(4,2,2,nb,ndir) 
    491                 m1 = child % childarray(5,1,2,nb,ndir) 
    492                 m2 = child % childarray(5,2,2,nb,ndir) 
    493                 n1 = child % childarray(6,1,2,nb,ndir) 
    494                 n2 = child % childarray(6,2,2,nb,ndir) 
    495  
    496                 call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), & 
    497                               i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir) 
    498             end select 
    499         endif 
    500     enddo 
    501     enddo 
    502  
    503     endif 
    504 ! 
    505  
    506403!--------------------------------------------------------------------------------------------------- 
    507404end subroutine Agrif_Correctnd 
     
    628525! 
    629526    INTEGER :: ir,jr,kr,lr,mr,nr 
    630     INTEGER :: kindexmax, isize,i 
    631     REAL,DIMENSION(:),ALLOCATABLE :: tabtemp 
    632  
    633     isize = 1 
    634     DO i=1,nbdim 
    635       isize = isize * (bounds(i,2)-bounds(i,1)+1) 
    636     ENDDO 
    637     IF (isize <= 0) RETURN 
    638  
    639     kindexmax = kindex + isize - 1 
    640     IF (.NOT.ALLOCATED(parray_temp)) THEN 
    641       ALLOCATE(parray_temp(kindexmax))  
    642     ELSE  
    643       IF (size(parray_temp) < kindexmax) THEN 
    644          ALLOCATE(tabtemp(size(parray_temp))) 
    645          tabtemp = parray_temp 
    646          DEALLOCATE(parray_temp) 
    647          ALLOCATE(parray_temp(kindexmax)) 
    648          parray_temp(1:size(tabtemp)) = tabtemp 
    649          DEALLOCATE(tabtemp) 
    650       ENDIF 
    651     ENDIF 
    652   
    653527! 
    654528    SELECT CASE (nbdim) 
     
    672546! 
    673547    CASE (3) 
    674  
    675         parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 
    676                                         c1t*child_var % oldvalues2d(2,kindex:kindexmax) 
    677  
     548        do kr = bounds(3,1),bounds(3,2) 
     549        do jr = bounds(2,1),bounds(2,2) 
     550!CDIR ALTCODE 
     551        do ir = bounds(1,1),bounds(1,2) 
     552            parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + & 
     553                                            c1t*child_var % oldvalues2d(2,kindex) 
     554            kindex = kindex + 1 
     555        enddo 
     556        enddo 
     557        enddo 
    678558! 
    679559    CASE (4) 
    680  
    681         parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 
    682                                         c1t*child_var % oldvalues2d(2,kindex:kindexmax) 
    683  
     560        do lr = bounds(4,1),bounds(4,2) 
     561        do kr = bounds(3,1),bounds(3,2) 
     562        do jr = bounds(2,1),bounds(2,2) 
     563!CDIR ALTCODE 
     564        do ir = bounds(1,1),bounds(1,2) 
     565            parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + & 
     566                                               c1t*child_var % oldvalues2d(2,kindex) 
     567            kindex = kindex + 1 
     568        enddo 
     569        enddo 
     570        enddo 
     571        enddo 
    684572! 
    685573    CASE (5) 
     
    717605        enddo 
    718606    END SELECT 
    719  
    720     kindex = kindexmax + 1 
    721  
    722607!--------------------------------------------------------------------------------------------------- 
    723608end subroutine timeInterpolation 
Note: See TracChangeset for help on using the changeset viewer.