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 1200 for trunk/AGRIF/AGRIF_FILES/modinterp.F – NEMO

Ignore:
Timestamp:
2008-09-24T15:05:20+02:00 (16 years ago)
Author:
rblod
Message:

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/AGRIF/AGRIF_FILES/modinterp.F

    r898 r1200  
    5454C  
    5555      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab, 
    56      &    torestore,nbdim)             
     56     &    torestore,nbdim,procname)             
    5757C 
    5858CCC   Description: 
    … …  
    7474      LOGICAL :: torestore 
    7575      REAL, DIMENSION( 
    76      &         lbound(child%var%array1,1):ubound(child%var%array1,1) 
     76     &         child%var%lb(1):child%var%ub(1) 
    7777     &         ), Target :: tab    ! Result 
     78      External :: procname 
     79      Optional ::  procname 
    7880C 
    7981C 
    … …  
    8890C     Tab is the result of the interpolation 
    8991      childtemp % var % array1 => tab  
     92       
     93      childtemp % var % lb = child % var % lb 
     94      childtemp % var % ub = child % var % ub   
     95             
    9096C       
    9197      if (torestore) then 
    … …  
    108114      childtemp % var % list_interp => child % var% list_interp             
    109115C       
     116      if (present(procname)) then 
     117      Call Agrif_InterpVariable 
     118     &     (TypeInterp,parent,childtemp,torestore,procname) 
     119      else 
    110120      Call Agrif_InterpVariable 
    111121     &     (TypeInterp,parent,childtemp,torestore) 
     122      endif 
    112123      child % var % list_interp => childtemp % var %list_interp      
    113124C       
    … …  
    124135C  
    125136      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab, 
    126      &                           torestore,nbdim)             
     137     &                           torestore,nbdim,procname)             
    127138C 
    128139CCC   Description: 
    … …  
    144155      LOGICAL :: torestore 
    145156      REAL, DIMENSION( 
    146      &    lbound(child%var%array2,1):ubound(child%var%array2,1), 
    147      &    lbound(child%var%array2,2):ubound(child%var%array2,2) 
     157     &         child%var%lb(1):child%var%ub(1), 
     158     &         child%var%lb(2):child%var%ub(2) 
    148159     &    ), Target :: tab    ! Result 
     160      External :: procname 
     161      Optional ::  procname 
    149162C 
    150163C 
    … …  
    159172C     Tab is the result of the interpolation 
    160173      childtemp % var % array2 => tab   
    161 C       
     174       
     175      childtemp % var % lb = child % var % lb 
     176      childtemp % var % ub = child % var % ub 
     177       
     178C 
    162179      if (torestore) then       
    163180C  
    164           childtemp % var % array2 = child % var % array2 
     181          childtemp % var % array2 = child % var % array2           
    165182C  
    166183          childtemp % var % restore2D => child % var % restore2D         
    … …  
    179196      childtemp % var % list_interp => child % var% list_interp           
    180197C      
     198      if (present(procname)) then 
     199      Call Agrif_InterpVariable 
     200     &     (TypeInterp,parent,childtemp,torestore,procname) 
     201      else 
    181202      Call Agrif_InterpVariable 
    182203     &     (TypeInterp,parent,childtemp,torestore) 
     204      endif 
     205 
    183206      child % var % list_interp => childtemp % var %list_interp      
    184207C       
    … …  
    195218C  
    196219      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab, 
    197      &   torestore,nbdim)             
     220     &   torestore,nbdim,procname)             
    198221C 
    199222CCC   Description: 
    … …  
    215238      LOGICAL :: torestore 
    216239      REAL, DIMENSION( 
    217      &      lbound(child%var%array3,1):ubound(child%var%array3,1), 
    218      &      lbound(child%var%array3,2):ubound(child%var%array3,2), 
    219      &      lbound(child%var%array3,3):ubound(child%var%array3,3) 
     240     &         child%var%lb(1):child%var%ub(1), 
     241     &         child%var%lb(2):child%var%ub(2), 
     242     &         child%var%lb(3):child%var%ub(3) 
    220243     &      ), Target :: tab  ! Results 
     244      External :: procname 
     245      Optional ::  procname 
    221246C 
    222247C 
    … …  
    231256C     Tab is the result of the interpolation  
    232257      childtemp % var % array3 => tab  
     258       
     259      childtemp % var % lb = child % var % lb 
     260      childtemp % var % ub = child % var % ub         
    233261C       
    234262      if (torestore) then 
    … …  
    251279      childtemp % var % list_interp => child % var% list_interp           
    252280C      
     281 
     282      if (present(procname)) then 
     283      Call Agrif_InterpVariable 
     284     &     (TypeInterp,parent,childtemp,torestore,procname) 
     285      else 
    253286      Call Agrif_InterpVariable 
    254287     &     (TypeInterp,parent,childtemp,torestore) 
     288      endif 
     289 
     290 
    255291      child % var % list_interp => childtemp % var %list_interp      
    256292C       
    … …  
    267303C  
    268304      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab, 
    269      &   torestore,nbdim)             
     305     &   torestore,nbdim,procname)             
    270306C 
    271307CCC   Description: 
    … …  
    287323      LOGICAL :: torestore 
    288324      REAL, DIMENSION( 
    289      &      lbound(child%var%array4,1):ubound(child%var%array4,1), 
    290      &      lbound(child%var%array4,2):ubound(child%var%array4,2), 
    291      &      lbound(child%var%array4,3):ubound(child%var%array4,3), 
    292      &      lbound(child%var%array4,4):ubound(child%var%array4,4) 
     325     &         child%var%lb(1):child%var%ub(1), 
     326     &         child%var%lb(2):child%var%ub(2), 
     327     &         child%var%lb(3):child%var%ub(3), 
     328     &         child%var%lb(4):child%var%ub(4) 
    293329     &      ), Target :: tab  ! Results 
     330      External :: procname 
     331      Optional ::  procname 
    294332C 
    295333C 
    … …  
    304342C     Tab is the result of the interpolation 
    305343      childtemp % var % array4 => tab  
     344       
     345      childtemp % var % lb = child % var % lb 
     346      childtemp % var % ub = child % var % ub   
     347             
    306348C  
    307349      if (torestore) then 
    … …  
    324366      childtemp % var % list_interp => child % var% list_interp            
    325367C      
     368      if (present(procname)) then 
     369      Call Agrif_InterpVariable 
     370     &     (TypeInterp,parent,childtemp,torestore,procname) 
     371      else 
    326372      Call Agrif_InterpVariable 
    327373     &     (TypeInterp,parent,childtemp,torestore) 
     374      endif 
     375 
     376 
    328377      child % var % list_interp => childtemp % var %list_interp 
    329378C       
    … …  
    340389C  
    341390      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab, 
    342      &   torestore,nbdim)             
     391     &   torestore,nbdim,procname)             
    343392C 
    344393CCC   Description: 
    … …  
    360409      LOGICAL :: torestore 
    361410      REAL, DIMENSION( 
    362      &      lbound(child%var%array5,1):ubound(child%var%array5,1), 
    363      &      lbound(child%var%array5,2):ubound(child%var%array5,2), 
    364      &      lbound(child%var%array5,3):ubound(child%var%array5,3), 
    365      &      lbound(child%var%array5,4):ubound(child%var%array5,4), 
    366      &      lbound(child%var%array5,5):ubound(child%var%array5,5) 
     411     &         child%var%lb(1):child%var%ub(1), 
     412     &         child%var%lb(2):child%var%ub(2), 
     413     &         child%var%lb(3):child%var%ub(3), 
     414     &         child%var%lb(4):child%var%ub(4), 
     415     &         child%var%lb(5):child%var%ub(5) 
    367416     &      ),  Target :: tab  ! Results 
     417      External :: procname 
     418      Optional ::  procname 
    368419C 
    369420C 
    … …  
    378429C     Tab is the result of the interpolation 
    379430      childtemp % var % array5 => tab   
     431       
     432      childtemp % var % lb = child % var % lb 
     433      childtemp % var % ub = child % var % ub   
     434             
    380435C       
    381436      if (torestore) then 
    … …  
    398453      childtemp % var % list_interp => child % var% list_interp           
    399454C       
     455      if (present(procname)) then 
     456      Call Agrif_InterpVariable 
     457     &     (TypeInterp,parent,childtemp,torestore,procname) 
     458      else 
    400459      Call Agrif_InterpVariable 
    401460     &     (TypeInterp,parent,childtemp,torestore) 
     461      endif 
     462 
    402463      
    403464      child % var % list_interp => childtemp % var %list_interp 
    … …  
    415476C  
    416477      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab, 
    417      &  torestore,nbdim)             
     478     &  torestore,nbdim,procname)             
    418479C 
    419480CCC   Description: 
    … …  
    435496      LOGICAL :: torestore 
    436497      REAL, DIMENSION( 
    437      &      lbound(child%var%array6,1):ubound(child%var%array6,1), 
    438      &      lbound(child%var%array6,2):ubound(child%var%array6,2), 
    439      &      lbound(child%var%array6,3):ubound(child%var%array6,3), 
    440      &      lbound(child%var%array6,4):ubound(child%var%array6,4), 
    441      &      lbound(child%var%array6,5):ubound(child%var%array6,5), 
    442      &      lbound(child%var%array6,6):ubound(child%var%array6,6) 
     498     &         child%var%lb(1):child%var%ub(1), 
     499     &         child%var%lb(2):child%var%ub(2), 
     500     &         child%var%lb(3):child%var%ub(3), 
     501     &         child%var%lb(4):child%var%ub(4), 
     502     &         child%var%lb(5):child%var%ub(5), 
     503     &         child%var%lb(6):child%var%ub(6) 
    443504     &      ),  Target :: tab  ! Results 
     505      External :: procname 
     506      Optional ::  procname 
    444507C 
    445508C 
    … …  
    454517C     Tab is the result of the interpolation 
    455518      childtemp % var % array6 => tab   
     519       
     520      childtemp % var % lb = child % var % lb 
     521      childtemp % var % ub = child % var % ub   
     522             
    456523C       
    457524      if (torestore) then 
    … …  
    475542      childtemp % var % list_interp => child % var% list_interp            
    476543C       
     544 
     545      if (present(procname)) then 
     546      Call Agrif_InterpVariable 
     547     &     (TypeInterp,parent,childtemp,torestore,procname) 
     548      else 
    477549      Call Agrif_InterpVariable 
    478550     &     (TypeInterp,parent,childtemp,torestore) 
     551      endif 
     552 
     553 
    479554C       
    480555      child % var % list_interp => childtemp % var %list_interp 
    … …  
    490565C     ************************************************************************** 
    491566C    
    492       Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore) 
     567      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore, 
     568     &            procname) 
    493569C 
    494570CCC   Description: 
    … …  
    521597      REAL    ,DIMENSION(6) :: s_child,s_parent 
    522598      REAL    ,DIMENSION(6) :: ds_child,ds_parent 
     599      External :: procname 
     600      Optional ::  procname 
     601 
    523602C 
    524603      Call PreProcessToInterpOrUpdate(parent,child, 
    … …  
    533612C     the grid variable 
    534613C 
     614 
     615      if (present(procname)) then 
     616      call Agrif_InterpnD 
     617     &            (TYPEinterp,parent,child, 
     618     &             pttab_Child(1:nbdim),petab_Child(1:nbdim), 
     619     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim), 
     620     &             s_Child(1:nbdim),s_Parent(1:nbdim), 
     621     &             ds_Child(1:nbdim),ds_Parent(1:nbdim), 
     622     &             child,torestore,nbdim,procname) 
     623      else 
    535624      call Agrif_InterpnD 
    536625     &            (TYPEinterp,parent,child, 
    … …  
    540629     &             ds_Child(1:nbdim),ds_Parent(1:nbdim), 
    541630     &             child,torestore,nbdim) 
     631 
     632      endif 
    542633C 
    543634      Return 
    … …  
    633724      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t 
    634725      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall 
    635       LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1       
     726      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 
    636727      LOGICAL, DIMENSION(1) :: memberin1 
    637728C 
    638729#endif       
    639730C      
     731 
    640732C    
    641733C     Boundaries of the current grid where interpolation is done 
    642734 
    643        
    644        
    645        
    646735      IF (Associated(child%var%list_interp)) THEN 
    647736      Call Agrif_Find_list_interp(child%var%list_interp,pttab,petab, 
    … …  
    659748       
    660749      IF (.not.find_list_interp) THEN 
     750 
    661751      Call Agrif_nbdim_Get_bound_dimension(child % var, 
    662752     &                               lowerbound,upperbound,nbdim) 
    663  
     753       
    664754      Call Agrif_Childbounds(nbdim,lowerbound,upperbound, 
    665755     &                                   pttab,petab, 
    … …  
    667757      
    668758C 
    669 C 
    670  
    671759      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob, 
    672760     &                        s_Parent_temp,s_Child_temp, 
    … …  
    677765     &                        child%var%root_var%posvar, 
    678766     &                        child % var % root_var % interptab) 
    679  
    680  
     767        
    681768#ifdef AGRIF_MPI 
    682769       IF (memberin) THEN 
    … …  
    689776     &                        child%var%root_var%posvar, 
    690777     &                        child % var % root_var % interptab) 
    691       ENDIF  
    692  
     778      ENDIF 
     779        
    693780      Call Agrif_nbdim_Get_bound_dimension(parent%var, 
    694781     &                              lowerbound,upperbound,nbdim) 
    695  
     782        
    696783      Call Agrif_ChildGrid_to_ParentGrid() 
    697784C 
    … …  
    739826            
    740827      ENDIF 
    741  
    742  
    743828 
    744829      IF (member) THEN 
    … …  
    855940#endif 
    856941     &    ) 
    857       endif 
    858        
     942      endif    
    859943C 
    860944C 
    … …  
    9451029 
    9461030 
    947 C 
    948 C 
    949 C     Special values on the child grid   
    950       if (Agrif_UseSpecialValueFineGrid) then 
    951 C 
    952 #ifdef AGRIF_MPI 
    953 C         
    954           Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var, 
    955      &                 childarray, 
    956      &                 pttruetab,cetruetab, 
    957      &                 Agrif_SpecialValueFineGrid,nbdim) 
    958 C 
    959 #else 
    960 C 
    961           Call GiveAgrif_SpecialValueToTab(child%var,tempC%var, 
    962      &                  pttruetab,cetruetab, 
    963      &                  Agrif_SpecialValueFineGrid,nbdim) 
    964 C 
    965 #endif  
    966 C 
    967 C         
    968       endif 
    9691031C   
    9701032 
    … …  
    9871049#endif 
    9881050 
     1051 
     1052C 
     1053C 
     1054C     Special values on the child grid   
     1055      if (Agrif_UseSpecialValueFineGrid) then 
     1056C 
     1057 
     1058          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var, 
     1059     &                 childarray, 
     1060     &                 pttruetab,cetruetab, 
     1061     &                 Agrif_SpecialValueFineGrid,nbdim) 
     1062 
     1063C         
     1064      endif 
     1065       
    9891066      endif 
    9901067 
    … …  
    10891166        CASE (2) 
    10901167           do j = pttruetab(2),cetruetab(2) 
    1091              do i = pttruetab(1),cetruetab(1)             
     1168             do i = pttruetab(1),cetruetab(1)  
    10921169              if (restore%var%restore2D(i,j) == 0)      
    10931170     &              child % var % array2(i,j) =  
    … …  
    20962173          ENDIF 
    20972174        EndDo 
    2098 C        print *,'ok trouve' 
     2175 
    20992176        indmin = parcours%interp_loc%indmin(1:nbdim) 
    21002177        indmax = parcours%interp_loc%indmax(1:nbdim) 
Note: See TracChangeset for help on using the changeset viewer.