00001 subroutine currentSet 00002 !< this routine works only if the pVec and dVec of p's are predetermined. 00003 00004 use global 00005 00006 implicit none 00007 00008 00009 integer myP,myD 00010 00011 integer dummy 00012 00013 integer startIndex,endIndex 00014 00015 00016 00017 globalCurrentSetLength=0 00018 globalCorrection=0 00019 00020 00021 do myP=1,size(pVec) 00022 00023 currentPhysics=pVec(myP) 00024 00025 dVec=>mymodel%physics(currentPhysics)%dVec 00026 00027 currentSetLength=0 00028 00029 00030 do myD=1,size(dVec) 00031 00032 currentDomain=dVec(myD) 00033 00034 call set 00035 00036 !print*,currentSetLength 00037 00038 globalCurrentSetLength=globalCurrentSetLength+currentSetLength 00039 00040 !print*,globalCurrentSetLength 00041 00042 00043 end do 00044 00045 00046 end do 00047 00048 if (allocated(myModel%setVec)) deallocate(myModel%setVec) 00049 00050 allocate(myModel%setVec(globalCurrentSetLength)) 00051 00052 setVec=>myModel%setVec 00053 00054 setVec=0 00055 00056 00057 !print*,globalsetvec 00058 00059 00060 00061 dummy=0 00062 00063 do myP=1,size(pVec) 00064 00065 currentPhysics=pVec(myP) 00066 00067 dVec=>mymodel%physics(currentPhysics)%dVec 00068 00069 00070 do myD=1,size(dVec) 00071 00072 currentDomain=dVec(myD) 00073 00074 !call set 00075 00076 localSetVec=>mymodel%physics(currentPhysics)%domain(currentDomain)%setVec 00077 00078 currentSetLength=size(localSetVec) 00079 00080 startIndex=dummy+1 00081 00082 endIndex=startIndex+currentSetLength-1 00083 00084 dummy=currentSetLength+dummy 00085 00086 setVec(startIndex:endIndex)=localSetVec 00087 00088 00089 end do 00090 00091 00092 end do 00093 00094 00095 00096 00097 00098 00099 end subroutine currentSet
1.6.1