|
XBeach
|
00001 ! 00002 ! demonstration how to use the mnemonics stuff 00003 ! 00004 program demo 00005 use spaceparams, only: spacepars 00006 use typesandkinds, only: slen 00007 use mnemmodule 00008 implicit none 00009 00010 type (spacepars) :: s 00011 00012 integer, parameter :: nnames = 4 00013 character(slen), dimension(nnames),parameter :: names=(/'xz','x','cx','nx'/) 00014 integer :: i 00015 ! 00016 ! alternatively, to let the compiler catch typing errors: 00017 00018 !character(slen), dimension(nnames), parameter :: names=(/mnem_xz,mnem_x,mnem_cx,mnem_nx/) 00019 00020 ! allocate scalars: 00021 call space_alloc_scalars(s) 00022 00023 ! allocate some arrays in s 00024 00025 allocate(s%xz(100)) 00026 00027 allocate(s%x(120,10)) 00028 allocate(s%cx(10,10,10)) 00029 ! 00030 ! note, there is a subroutine space_alloc_arrays in 00031 ! spaceparams.F90 to allocate all arrays in s. 00032 ! That subroutine needs filled-in variables i s and par 00033 ! 00034 00035 00036 ! Give the variables a value, using their names in array names 00037 00038 do i=1,nnames 00039 call setvar(s,names(i),dble(i)) 00040 enddo 00041 00042 ! and show that the values are there: 00043 00044 write(*,*)'nx:',s%nx 00045 write(*,*)'nxz:',s%xz(1) 00046 write(*,*)'x:',s%x(1,1) 00047 write(*,*)'cx:',s%cx(1,1,1) 00048 00049 end program demo 00050 00051 ! example code to demonstrate indextos and chartoindex 00052 ! The first element of the named variable will be set to 00053 ! zero 00054 subroutine setvar(s,name,value) 00055 use spaceparams 00056 use mnemmodule 00057 implicit none 00058 type(spacepars) :: s 00059 character(len=*) :: name 00060 real*8 :: value 00061 00062 integer :: index 00063 type (arraytype) :: t 00064 00065 index = chartoindex(name) !determine index from name 00066 call indextos(s,index,t) !get info and pointer 00067 write(*,*)'setting '//trim(name)//' to ',value 00068 write(*,*)'some properties of '//trim(name)//':' 00069 call printvar(t) 00070 ! 00071 ! print some 00072 ! depending on s%type and s%rank, we have now a pointer 00073 ! to the desired variable 00074 ! 00075 ! Fortran90 pointer type checking is quite strict: no void pointer 00076 ! available. So we have to catch every type and rank of array. 00077 ! See also mnemonic.F90 00078 ! 00079 00080 select case (t%type) 00081 case ('r') ! type is integer 00082 select case (t%rank) 00083 case(0) ! scalar 00084 t%r0 = value 00085 case(1) ! (:) 00086 t%r1 = value 00087 case(2) ! (:,:) 00088 t%r2 = value 00089 case(3) ! (:,:,:) 00090 t%r3 = value 00091 case(4) ! (:,:,:,:) 00092 t%r4 = value 00093 end select 00094 case ('i') ! type is real*8 00095 select case (t%rank) 00096 case(0) ! scalar 00097 t%i0 = value 00098 case(1) ! (:) 00099 t%i1 = value 00100 case(2) ! (:,:) 00101 t%i2 = value 00102 case(3) ! (:,:,:) 00103 t%i3 = value 00104 case(4) ! (:,:,:,:) 00105 t%i4 = value 00106 end select 00107 end select 00108 end subroutine setvar 00109
1.7.6.1
