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/modutil.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/modutil.F

    r1901 r2671  
    11! 
    2 ! $Id: modutil.F 1793 2010-01-06 19:20:12Z rblod $ 
     2! $Id: modutil.F 662 2007-05-25 15:58:52Z opalod $ 
    33! 
    44C     Agrif (Adaptive Grid Refinement In Fortran) 
    … …  
    6363C 
    6464#ifdef AGRIF_MPI 
    65       Logical      :: mpi_was_called 
    66       Integer      :: code, ierr 
     65      Integer      :: code 
    6766#include "mpif.h" 
    6867C 
    6968C 
    70       Call Agrif_comm_def(mpi_comm_agrif) 
    71  
    72       CALL mpi_initialized ( mpi_was_called, code ) 
    73       IF( code /= MPI_SUCCESS ) THEN 
    74          WRITE(*, *) ': Error in routine mpi_initialized' 
    75          CALL mpi_abort( mpi_comm_world, code, ierr ) 
    76       ENDIF 
    77  
    78       IF( .NOT. mpi_was_called ) THEN  
    79          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_agrif, code) 
    80          IF( code /= MPI_SUCCESS ) THEN 
    81             WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup' 
    82             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    83          ENDIF 
    84       ENDIF 
    85  
    8669      If (Agrif_Mygrid % ngridstep == 0) Then 
    87           Call MPI_COMM_SIZE(MPI_COMM_AGRIF,Agrif_Nbprocs,code) 
    88           Call MPI_COMM_RANK(MPI_COMM_AGRIF,Agrif_ProcRank,code) 
    89           Call MPI_COMM_GROUP(MPI_COMM_AGRIF,Agrif_Group,code) 
     70          Call MPI_COMM_SIZE(MPI_COMM_WORLD,Agrif_Nbprocs,code) 
     71          Call MPI_COMM_RANK(MPI_COMM_WORLD,Agrif_ProcRank,code) 
     72          Call MPI_COMM_GROUP(MPI_COMM_WORLD,Agrif_Group,code) 
    9073      endif 
    9174#endif 
    … …  
    234217C 
    235218      if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then 
     219C 
     220      Call Agrif_Save_All(Agrif_oldmygrid)       
    236221C       
    237222      Call Agrif_Free_before_All(Agrif_oldmygrid) 
    … …  
    322307C     Detection (Agrif_detect is a user s routine) 
    323308C       
     309      
    324310      do iii = 1 , Agrif_Probdim 
    325311         size(iii) = g%nb(iii) + 1 
    … …  
    440426C 
    441427      End Subroutine Agrif_Free_before_All 
     428C     ************************************************************************** 
     429CCC   Subroutine Agrif_Save_All 
     430C     ************************************************************************** 
     431C 
     432      Recursive Subroutine Agrif_Save_All(g) 
     433C 
     434CCC   Description: 
     435C 
     436CC    Method:         
     437C 
     438C     Declarations: 
     439C 
     440C     Pointer argument     
     441      Type(Agrif_pgrid),pointer   :: g        ! Pointer on the current grid 
     442C 
     443C     Local pointer 
     444      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive  
     445                                             ! procedure       
     446C 
     447C 
     448      parcours => g         
     449C       
     450      Do while (associated(parcours))      
     451        If (.not. parcours%gr%fixed) Then 
     452            Call Agrif_Instance(parcours%gr) 
     453            Call Agrif_Before_Regridding() 
     454            parcours % gr % oldgrid = .TRUE.         
     455        endif 
     456C 
     457        Call Agrif_Save_All (parcours % gr % child_grids) 
     458C   
     459        parcours => parcours % next              
     460      enddo 
     461C      
     462      Return       
     463C 
     464C 
     465      End Subroutine Agrif_Save_All       
    442466C 
    443467C 
    … …  
    710734C     The root coarse grid is a fixed grid 
    711735      Agrif_Mygrid % fixed = .TRUE. 
     736C     Level of the root grid 
     737      Agrif_Mygrid % level = 0 
     738C     Maximum level in the hierarchy 
     739      Agrif_MaxLevelLoc = 0 
     740       
    712741C       
    713742C     Number of the grid pointed by Agrif_Mygrid (root coarse grid) 
    … …  
    724753      Call Agrif_Set_numberofcells(Agrif_Mygrid) 
    725754C       
    726       Call Agrif_Instance (Agrif_Mygrid)         
     755      Call Agrif_Instance (Agrif_Mygrid)       
     756C 
     757      Call Agrif_Set_numberofcells(Agrif_Mygrid)           
    727758C              
    728759C     Allocation of the array containing the values of the grid variables 
    729760      Call Agrif_Allocation (Agrif_Mygrid) 
    730761C         
    731       Call Agrif_initialisations(Agrif_Mygrid) 
     762      Call Agrif_initialisations(Agrif_Mygrid)     
    732763C       
    733764      nullify(Agrif_Mygrid % child_grids) 
    … …  
    759790C 
    760791      do nb = 1, Agrif_NbVariables 
    761           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array1) )  
     792          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) )  
    762793     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1) 
    763           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array2) )  
     794          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) )  
    764795     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2) 
    765           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array3) )  
     796          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) )  
    766797     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3) 
    767           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array4) )  
     798          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) )  
    768799     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4) 
    769           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array5) )  
     800          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) )  
    770801     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5) 
    771           if ( associated(Agrif_Mygrid % tabvars(nb) % var % array6) )  
     802          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) )  
    772803     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6) 
    773804C 
    774           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray1) )  
     805          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) )  
    775806     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1) 
    776           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray2) )  
     807          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) )  
    777808     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2) 
    778           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray3) )  
     809          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) )  
    779810     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3) 
    780           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray4) )  
     811          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) )  
    781812     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4) 
    782           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray5) )  
     813          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) )  
    783814     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5) 
    784           if ( associated(Agrif_Mygrid % tabvars(nb) % var % iarray6) )  
     815          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) )  
    785816     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6) 
    786817C 
    787           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray1) )  
     818          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) )  
    788819     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1) 
    789           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray2) )  
     820          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) )  
    790821     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2) 
    791           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray3) )  
     822          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) )  
    792823     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3) 
    793           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray4) )  
     824          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) )  
    794825     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4) 
    795           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray5) )  
     826          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) )  
    796827     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5) 
    797           if ( associated(Agrif_Mygrid % tabvars(nb) % var % larray6) )  
     828          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) )  
    798829     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6) 
    799830C 
    800           if ( associated(Agrif_Mygrid % tabvars(nb) % var % carray1) )  
     831          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) )  
    801832     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1) 
    802           if ( associated(Agrif_Mygrid % tabvars(nb) % var % carray2) )  
     833          if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) )  
    803834     &       Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2) 
    804835      enddo 
Note: See TracChangeset for help on using the changeset viewer.