CP2K: reallocate_2.f90 Source File

CP2K 2.4 (Revision 12889)
00001     INTEGER                                  :: istat, lb1, lb1_old, lb2, 
00002                                                 lb2_old, ub1, ub1_old, ub2, ub2_old
00003 
00004     IF (ASSOCIATED(p)) THEN
00005        lb1_old = LBOUND(p,1)
00006        ub1_old = UBOUND(p,1)
00007        lb2_old = LBOUND(p,2)
00008        ub2_old = UBOUND(p,2)
00009        lb1 = MAX(lb1_new,lb1_old)
00010        ub1 = MIN(ub1_new,ub1_old)
00011        lb2 = MAX(lb2_new,lb2_old)
00012        ub2 = MIN(ub2_new,ub2_old)
00013        ALLOCATE (work(lb1:ub1,lb2:ub2),STAT=istat)
00014        IF (istat /= 0) THEN
00015           CALL stop_memory(routineN,moduleN,__LINE__,&
00016                            "work",t_size*(ub1-lb1+1)*&
00017                                          (ub2-lb2+1))
00018 
00019        END IF
00020        work(lb1:ub1,lb2:ub2) = p(lb1:ub1,lb2:ub2)
00021        DEALLOCATE (p,STAT=istat)
00022        IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,"p")
00023     END IF
00024 
00025     ALLOCATE (p(lb1_new:ub1_new,lb2_new:ub2_new),STAT=istat)
00026     IF (istat /= 0) THEN
00027        CALL stop_memory(routineN,moduleN,__LINE__,&
00028                         "p",t_size*(ub1_new-lb1_new+1)*&
00029                                    (ub2_new-lb2_new+1))
00030     END IF
00031     p(:,:) = zero
00032 
00033     IF (ASSOCIATED(p).AND.ALLOCATED(work)) THEN
00034        p(lb1:ub1,lb2:ub2) = work(lb1:ub1,lb2:ub2)
00035        DEALLOCATE (work,STAT=istat)
00036        IF (istat /= 0) CALL stop_memory(routineN,moduleN,__LINE__,"work")
00037     END IF