Ignore:
Timestamp:
2018-09-05T15:33:44+02:00 (2 years ago)
Author:
rblod
Message:

update AGRIF library

File:
1 edited

Legend:

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

    r5656 r10087  
    3232! 
    3333    implicit none 
     34    REAL,DIMENSION(:),ALLOCATABLE :: parray_temp 
    3435! 
    3536contains 
     
    6162    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border 
    6263                                                !    with the root grid 
    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 
     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 
    6566! 
    6667    call PreProcessToInterpOrUpdate( parent,   child,       & 
     
    145146    INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2) 
    146147    INTEGER, DIMENSION(nbdim)   :: loctab_Child         !< Indicates if the child grid has a common border with the root grid 
    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 
     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 
    149150    INTEGER                             :: nbdim        !< Number of dimensions of the grid variable 
    150151    procedure()                         :: procname     !< Data recovery procedure 
     
    159160    INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated 
    160161    INTEGER,DIMENSION(nbdim)            :: coords 
    161     INTEGER                             :: i, nb, ndir 
     162    INTEGER                             :: i, nb, ndir,j,k,l 
    162163    INTEGER                             :: n, sizetab 
    163164    INTEGER                             :: ibeg, iend 
    164165    INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2 
    165166    REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t) 
     167    INTEGER :: isize 
     168    INTEGER :: kindex_2d(2,nbdim) 
     169 
    166170#if defined AGRIF_MPI 
    167171! 
     
    188192    END WHERE 
    189193! 
    190     call Agrif_get_var_global_bounds(child,lubglob,nbdim) 
     194!   call Agrif_get_var_global_bounds(child,lubglob,nbdim) 
     195    lubglob = child%lubglob(1:nbdim,:) 
    191196! 
    192197    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) 
     
    194199    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2)) 
    195200    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2)) 
     201    
    196202! 
    197203    do nb = 1,nbdim 
     
    267273                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 
    268274! 
     275 
    269276                    call Agrif_InterpnD(type_interp, parent, child,             & 
    270277                                        ptres(1:nbdim,1,ndir,nb),               & 
     
    319326        do nb = 1,nbdim 
    320327            do ndir = 1,2 
    321                 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then 
     328                kindex_2d(ndir,nb) = kindex 
     329                if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then 
    322330                    Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim) 
    323331                endif 
     
    325333        enddo 
    326334! 
    327     endif 
    328 ! 
    329335    do nb = 1,nbdim 
    330336    do ndir = 1,2 
    331337        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 
    332350            select case(nbdim) 
    333351            case(1) 
     
    346364                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir) 
    347365            case(3) 
     366 
    348367                i1 = child % childarray(1,1,2,nb,ndir) 
    349368                i2 = child % childarray(1,2,2,nb,ndir) 
     
    353372                k2 = child % childarray(3,2,2,nb,ndir) 
    354373 
    355                 call procname(parray3(i1:i2,j1:j2,k1:k2),                   & 
    356                               i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 
     374               call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) 
     375 
    357376            case(4) 
    358377                i1 = child % childarray(1,1,2,nb,ndir) 
     
    365384                l2 = child % childarray(4,2,2,nb,ndir) 
    366385 
    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) 
     386                call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2,l1,l2,.FALSE.,coords(nb),ndir) 
     387 
    369388            case(5) 
    370389                i1 = child % childarray(1,1,2,nb,ndir) 
     
    401420    enddo 
    402421    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 
    403506!--------------------------------------------------------------------------------------------------- 
    404507end subroutine Agrif_Correctnd 
     
    525628! 
    526629    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  
    527653! 
    528654    SELECT CASE (nbdim) 
     
    546672! 
    547673    CASE (3) 
    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 
     674 
     675        parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 
     676                                        c1t*child_var % oldvalues2d(2,kindex:kindexmax) 
     677 
    558678! 
    559679    CASE (4) 
    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 
     680 
     681        parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + & 
     682                                        c1t*child_var % oldvalues2d(2,kindex:kindexmax) 
     683 
    572684! 
    573685    CASE (5) 
     
    605717        enddo 
    606718    END SELECT 
     719 
     720    kindex = kindexmax + 1 
     721 
    607722!--------------------------------------------------------------------------------------------------- 
    608723end subroutine timeInterpolation 
Note: See TracChangeset for help on using the changeset viewer.