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 2671 for vendors/AGRIF/current/AGRIF_FILES/modsauv.F – NEMO

Ignore:
Timestamp:
2011-03-08T15:08:49+01:00 (13 years ago)
Author:
rblod
Message:

Load working_directory into vendors/AGRIF/current.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • vendors/AGRIF/current/AGRIF_FILES/modsauv.F

    r1901 r2671  
    11! 
    2 ! $Id: modsauv.F 1200 2008-09-24 13:05:20Z rblod $ 
     2! $Id: modsauv.F 662 2007-05-25 15:58:52Z opalod $ 
    33! 
    44C     AGRIF (Adaptive Grid Refinement In Fortran) 
    … …  
    3535      Use Agrif_Link 
    3636      Use Agrif_Arrays 
     37      Use Agrif_Variables 
    3738C 
    3839      IMPLICIT NONE 
    … …  
    4243C 
    4344C 
     45      Subroutine Agrif_Deallocate_Arrays(Var) 
     46      type(Agrif_Variable), pointer :: Var 
     47       
     48            if (ALLOCATED(var%array1)) then 
     49               Deallocate(var%array1) 
     50            endif 
     51            if (ALLOCATED(var%array2)) then 
     52               Deallocate(var%array2) 
     53            endif 
     54            if (ALLOCATED(var%array3)) then 
     55               Deallocate(var%array3) 
     56            endif 
     57            if (ALLOCATED(var%array4)) then 
     58               Deallocate(var%array4) 
     59            endif 
     60            if (ALLOCATED(var%array5)) then 
     61               Deallocate(var%array5) 
     62            endif 
     63            if (ALLOCATED(var%array6)) then 
     64               Deallocate(var%array6) 
     65            endif 
     66C 
     67            if (ALLOCATED(var%darray1)) then 
     68               Deallocate(var%darray1) 
     69            endif 
     70            if (ALLOCATED(var%darray2)) then 
     71               Deallocate(var%darray2) 
     72            endif 
     73            if (ALLOCATED(var%darray3)) then 
     74               Deallocate(var%darray3) 
     75            endif 
     76            if (ALLOCATED(var%darray4)) then 
     77               Deallocate(var%darray4) 
     78            endif 
     79            if (ALLOCATED(var%darray5)) then 
     80               Deallocate(var%darray5) 
     81            endif 
     82            if (ALLOCATED(var%darray6)) then 
     83               Deallocate(var%darray6) 
     84            endif 
     85C 
     86            if (ALLOCATED(var%larray1)) then 
     87               Deallocate(var%larray1) 
     88            endif 
     89            if (ALLOCATED(var%larray2)) then 
     90               Deallocate(var%larray2) 
     91            endif 
     92            if (ALLOCATED(var%larray3)) then 
     93               Deallocate(var%larray3) 
     94            endif 
     95            if (ALLOCATED(var%larray4)) then 
     96               Deallocate(var%larray4) 
     97            endif 
     98            if (ALLOCATED(var%larray5)) then 
     99               Deallocate(var%larray5) 
     100            endif 
     101            if (ALLOCATED(var%larray6)) then 
     102               Deallocate(var%larray6) 
     103            endif 
     104C 
     105            if (ALLOCATED(var%iarray1)) then 
     106               Deallocate(var%iarray1) 
     107            endif 
     108            if (ALLOCATED(var%iarray2)) then 
     109               Deallocate(var%iarray2) 
     110            endif 
     111            if (ALLOCATED(var%iarray3)) then 
     112               Deallocate(var%iarray3) 
     113            endif 
     114            if (ALLOCATED(var%iarray4)) then 
     115               Deallocate(var%iarray4) 
     116            endif 
     117            if (ALLOCATED(var%iarray5)) then 
     118               Deallocate(var%iarray5) 
     119            endif 
     120            if (ALLOCATED(var%iarray6)) then 
     121               Deallocate(var%iarray6) 
     122            endif 
     123C 
     124            if (ALLOCATED(var%carray1)) then 
     125               Deallocate(var%carray1) 
     126            endif 
     127            if (ALLOCATED(var%carray2)) then 
     128               Deallocate(var%carray2) 
     129            endif 
     130C 
     131            if (associated(var%oldvalues2D)) then 
     132               Deallocate(var%oldvalues2D) 
     133            endif 
     134            if (associated(var%interpIndex)) then 
     135               Deallocate(var%interpIndex) 
     136            endif 
     137             
     138            if (associated(var%posvar)) then 
     139               Deallocate(var%posvar) 
     140            endif      
     141             
     142            if (associated(var%interptab)) then 
     143               Deallocate(var%interptab) 
     144            endif 
     145             
     146      Return 
     147      End Subroutine Agrif_Deallocate_Arrays     
    44148C 
    45149C     ************************************************************************** 
    … …  
    62166      TYPE(Agrif_Grid),pointer   :: Agrif_Gr ! Pointer on the current grid 
    63167      INTEGER i  
     168      Type(Agrif_List_Variables), pointer :: parcours       
    64169C 
    65170C    
    … …  
    67172         if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 
    68173C  
    69             if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 
    70                Deallocate(Agrif_Gr%tabvars(i)%var%array1) 
    71             endif 
    72             if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 
    73                Deallocate(Agrif_Gr%tabvars(i)%var%array2) 
    74             endif 
    75             if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 
    76                Deallocate(Agrif_Gr%tabvars(i)%var%array3) 
    77             endif 
    78             if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 
    79                Deallocate(Agrif_Gr%tabvars(i)%var%array4) 
    80             endif 
    81             if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 
    82                Deallocate(Agrif_Gr%tabvars(i)%var%array5) 
    83             endif 
    84             if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 
    85                Deallocate(Agrif_Gr%tabvars(i)%var%array6) 
    86             endif 
    87 C 
    88             if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then 
    89                Deallocate(Agrif_Gr%tabvars(i)%var%darray1) 
    90             endif 
    91             if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then 
    92                Deallocate(Agrif_Gr%tabvars(i)%var%darray2) 
    93             endif 
    94             if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then 
    95                Deallocate(Agrif_Gr%tabvars(i)%var%darray3) 
    96             endif 
    97             if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then 
    98                Deallocate(Agrif_Gr%tabvars(i)%var%darray4) 
    99             endif 
    100             if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then 
    101                Deallocate(Agrif_Gr%tabvars(i)%var%darray5) 
    102             endif 
    103             if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then 
    104                Deallocate(Agrif_Gr%tabvars(i)%var%darray6) 
    105             endif 
    106 C 
    107             if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then 
    108                Deallocate(Agrif_Gr%tabvars(i)%var%larray1) 
    109             endif 
    110             if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then 
    111                Deallocate(Agrif_Gr%tabvars(i)%var%larray2) 
    112             endif 
    113             if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then 
    114                Deallocate(Agrif_Gr%tabvars(i)%var%larray3) 
    115             endif 
    116             if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then 
    117                Deallocate(Agrif_Gr%tabvars(i)%var%larray4) 
    118             endif 
    119             if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then 
    120                Deallocate(Agrif_Gr%tabvars(i)%var%larray5) 
    121             endif 
    122             if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then 
    123                Deallocate(Agrif_Gr%tabvars(i)%var%larray6) 
    124             endif 
    125 C 
    126             if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then 
    127                Deallocate(Agrif_Gr%tabvars(i)%var%iarray1) 
    128             endif 
    129             if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then 
    130                Deallocate(Agrif_Gr%tabvars(i)%var%iarray2) 
    131             endif 
    132             if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then 
    133                Deallocate(Agrif_Gr%tabvars(i)%var%iarray3) 
    134             endif 
    135             if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then 
    136                Deallocate(Agrif_Gr%tabvars(i)%var%iarray4) 
    137             endif 
    138             if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then 
    139                Deallocate(Agrif_Gr%tabvars(i)%var%iarray5) 
    140             endif 
    141             if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then 
    142                Deallocate(Agrif_Gr%tabvars(i)%var%iarray6) 
    143             endif 
    144 C 
    145             if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then 
    146                Deallocate(Agrif_Gr%tabvars(i)%var%carray1) 
    147             endif 
    148             if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then 
    149                Deallocate(Agrif_Gr%tabvars(i)%var%carray2) 
    150             endif 
    151 C 
    152             if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then 
    153                Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D) 
    154             endif 
    155             if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then 
    156                Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex) 
    157             endif 
     174            call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 
    158175             
    159             if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 
    160                Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 
    161             endif      
    162              
    163             if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 
    164                Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 
    165             endif   
    166              
    167        endif 
     176          endif 
    168177            
    169178C 
    170        if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then 
    171          Call Agrif_Free_list_interp 
     179         if (associated(Agrif_Gr%tabvars(i)%var%list_interp)) then 
     180           Call Agrif_Free_list_interp 
    172181     &                          (Agrif_Gr%tabvars(i)%var%list_interp) 
    173        endif                              
     182         endif                              
    174183C 
    175184       if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 
    … …  
    177186C  
    178187        endif 
     188      enddo 
     189       
     190      parcours => Agrif_Gr%variables 
     191     
     192      do i=1,Agrif_Gr%NbVariables 
     193       if (.NOT. parcours%pvar%var%root_var%restaure) then 
     194        call Agrif_Deallocate_Arrays(parcours%pvar%var) 
     195       endif 
     196        if (associated(parcours%pvar%var%list_interp)) then 
     197           Call Agrif_Free_list_interp 
     198     &                          (parcours%pvar%var%list_interp) 
     199         endif                              
     200C 
     201       if ( .NOT. parcours%pvar%var%root_var % restaure) then 
     202            Deallocate(parcours%pvar%var) 
     203C  
     204        endif 
     205        parcours => parcours%nextvariable 
    179206      enddo 
    180207C 
    … …  
    231258      TYPE(Agrif_Grid),pointer   :: Agrif_Gr  ! Pointer on the current grid 
    232259      INTEGER i 
     260      Type(Agrif_List_Variables), pointer :: parcours, rootparcours 
    233261C 
    234262C       
    235263      do i = 1 , AGRIF_NbVariables 
    236264         if ( Agrif_Mygrid % tabvars(i) % var % restaure) then 
    237 C  
    238             if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 
    239                Deallocate(Agrif_Gr%tabvars(i)%var%array1) 
    240             endif 
    241             if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 
    242                Deallocate(Agrif_Gr%tabvars(i)%var%array2) 
    243             endif 
    244             if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 
    245                Deallocate(Agrif_Gr%tabvars(i)%var%array3) 
    246             endif 
    247             if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 
    248                Deallocate(Agrif_Gr%tabvars(i)%var%array4) 
    249             endif 
    250             if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 
    251                Deallocate(Agrif_Gr%tabvars(i)%var%array5) 
    252             endif 
    253             if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 
    254                Deallocate(Agrif_Gr%tabvars(i)%var%array6) 
    255             endif 
    256 ! 
    257             if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then 
    258                Deallocate(Agrif_Gr%tabvars(i)%var%darray1) 
    259             endif 
    260             if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then 
    261                Deallocate(Agrif_Gr%tabvars(i)%var%darray2) 
    262             endif 
    263             if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then 
    264                Deallocate(Agrif_Gr%tabvars(i)%var%darray3) 
    265             endif 
    266             if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then 
    267                Deallocate(Agrif_Gr%tabvars(i)%var%darray4) 
    268             endif 
    269             if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then 
    270                Deallocate(Agrif_Gr%tabvars(i)%var%darray5) 
    271             endif 
    272             if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then 
    273                Deallocate(Agrif_Gr%tabvars(i)%var%darray6) 
    274             endif 
    275 ! 
    276             if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then 
    277                Deallocate(Agrif_Gr%tabvars(i)%var%larray1) 
    278             endif 
    279             if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then 
    280                Deallocate(Agrif_Gr%tabvars(i)%var%larray2) 
    281             endif 
    282             if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then 
    283                Deallocate(Agrif_Gr%tabvars(i)%var%larray3) 
    284             endif 
    285             if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then 
    286                Deallocate(Agrif_Gr%tabvars(i)%var%larray4) 
    287             endif 
    288             if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then 
    289                Deallocate(Agrif_Gr%tabvars(i)%var%larray5) 
    290             endif 
    291             if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then 
    292                Deallocate(Agrif_Gr%tabvars(i)%var%larray6) 
    293             endif 
    294 ! 
    295             if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then 
    296                Deallocate(Agrif_Gr%tabvars(i)%var%iarray1) 
    297             endif 
    298             if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then 
    299                Deallocate(Agrif_Gr%tabvars(i)%var%iarray2) 
    300             endif 
    301             if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then 
    302                Deallocate(Agrif_Gr%tabvars(i)%var%iarray3) 
    303             endif 
    304             if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then 
    305                Deallocate(Agrif_Gr%tabvars(i)%var%iarray4) 
    306             endif 
    307             if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then 
    308                Deallocate(Agrif_Gr%tabvars(i)%var%iarray5) 
    309             endif 
    310             if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then 
    311                Deallocate(Agrif_Gr%tabvars(i)%var%iarray6) 
    312             endif 
    313 ! 
    314             if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then 
    315                Deallocate(Agrif_Gr%tabvars(i)%var%carray1) 
    316             endif 
    317             if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then 
    318                Deallocate(Agrif_Gr%tabvars(i)%var%carray2) 
    319             endif 
    320 ! 
    321             if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then 
    322                Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D) 
    323             endif 
    324             if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then 
    325                Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex) 
    326             endif 
    327              
    328             if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 
    329                Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 
    330             endif      
    331              
    332             if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 
    333                Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 
    334             endif                   
    335 ! 
     265          
     266         call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 
     267         ! 
    336268            Deallocate(Agrif_Gr%tabvars(i)%var) 
    337269!  
    338270         endif 
    339271      enddo 
     272       
     273      parcours => Agrif_Gr%variables 
     274      rootparcours=>Agrif_Mygrid%variables 
     275     
     276      do i=1,Agrif_Gr%NbVariables 
     277       if (rootparcours%pvar%var%restaure) then 
     278        call Agrif_Deallocate_Arrays(parcours%pvar%var) 
     279       
     280            Deallocate(parcours%pvar%var) 
     281C  
     282        endif 
     283        parcours => parcours%nextvariable 
     284        rootparcours => rootparcours%nextvariable         
     285      enddo 
     286             
    340287C 
    341288C       
    … …  
    464411C       
    465412      End Subroutine Agrif_CopyFromold 
     413       
     414CC    ************************************************************************** 
     415CCC   Subroutine AGRIF_CopyFromold_AllOneVar 
     416C     ************************************************************************** 
     417C 
     418      Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids, 
     419     &   indic) 
     420C 
     421CCC   Description: 
     422CCC   Routine called in the Agrif_Init_Hierarchy procedure  
     423C       (Agrif_Clustering module).  
     424C 
     425CC    Method:         
     426C 
     427C     Declarations: 
     428C 
     429       
     430C       
     431C     Pointer argument     
     432      TYPE(AGRIF_grid),pointer   :: g ! Pointer on the current grid 
     433      TYPE(AGRIF_pgrid),pointer   :: oldchildgrids 
     434      integer :: indic 
     435C 
     436C     Local pointer 
     437      TYPE(AGRIF_pgrid),pointer  :: parcours ! Pointer for the recursive  
     438                                             ! procedure  
     439      REAL g_eps,eps,oldgrid_eps 
     440      INTEGER :: out 
     441      INTEGER :: iii 
     442C 
     443      out = 0 
     444C                                                                            
     445      parcours => oldchildgrids   
     446C 
     447      do while (associated(parcours)) 
     448C  
     449        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then 
     450C         
     451            g_eps = huge(1.) 
     452            oldgrid_eps = huge(1.) 
     453            do iii = 1 , Agrif_Probdim 
     454               g_eps = min(g_eps,g % Agrif_d(iii)) 
     455               oldgrid_eps = min(oldgrid_eps, 
     456     &                       parcours % gr % Agrif_d(iii)) 
     457            enddo 
     458C 
     459            eps = min(g_eps,oldgrid_eps)/100.                   
     460C 
     461            do iii = 1 , Agrif_Probdim 
     462 
     463               if (g % Agrif_d(iii) .LT.  
     464     &             (parcours % gr % Agrif_d(iii) - eps)) then 
     465C             
     466                   parcours => parcours % next 
     467C             
     468                   out = 1 
     469C    
     470                   Exit 
     471C              
     472               endif 
     473C       
     474            enddo 
     475        if ( out .EQ. 1 ) Cycle 
     476C 
     477            Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic) 
     478C 
     479        endif 
     480C                      
     481        Call Agrif_CopyFromold_AllOneVar 
     482     &             (g, parcours % gr % child_grids,indic) 
     483C         
     484        parcours => parcours % next 
     485C         
     486      enddo 
     487C 
     488C      
     489      Return       
     490C 
     491C 
     492      End Subroutine AGRIF_CopyFromold_AllOneVar 
     493C 
     494C 
     495C       
     496C     ************************************************************************** 
     497CCC   Subroutine Agrif_CopyFromoldOneVar 
     498C     ************************************************************************** 
     499C       
     500      Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr, 
     501     &    indic) 
     502C 
     503CCC   Description: 
     504CCC   Call to the Agrif_Copy procedure. 
     505C 
     506CC    Method: 
     507CC             
     508C 
     509C     Declarations: 
     510C 
     511       
     512C       
     513C     Pointer argument     
     514      TYPE(Agrif_Grid),Pointer   :: Agrif_New_Gr  ! Pointer on the current grid 
     515      TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr    ! Pointer on an old grid 
     516      INTEGER :: indic 
     517      INTEGER :: i 
     518      TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars       
     519C 
     520C       
     521      tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic) 
     522      oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic) 
     523 
     524      Call Agrif_Nbdim_Allocation(tabvars%var, 
     525     &  tabvars%var%lb,tabvars%var%ub, 
     526     &  tabvars%var%nbdim) 
     527      
     528      Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr, 
     529     &           tabvars,oldtabvars) 
     530 
     531 
     532C       
     533C             
     534      Return 
     535C 
     536C       
     537      End Subroutine Agrif_CopyFromoldOneVar       
     538       
    466539C 
    467540C 
    … …  
    753826         enddo 
    754827      CASE (2) 
     828 
    755829        i0 = ind_gmin(1) 
    756830        do i = ind_newmin(1),ind_newmax(1) 
Note: See TracChangeset for help on using the changeset viewer.