Realloc with OpenMP fixes.

3 years ago · 57d9ac33c5
parent 347ed5638e
commit 57d9ac33c5
7 changed files with 294 additions and 0 deletions
--- a/base/modules/auxil/psb_c_realloc_mod.F90
+++ b/base/modules/auxil/psb_c_realloc_mod.F90
@ -982,7 +982,48 @@ Contains
      goto 9999
    end if

+!!$    If (len > psb_size(v)) Then
+!!$      if (present(newsz)) then 
+!!$        isz = (max(len+1,newsz))
+!!$      else
+!!$        if (present(addsz)) then 
+!!$          isz = len+max(1,addsz)
+!!$        else
+!!$          isz = max(len+10, int(1.25*len))
+!!$        endif
+!!$      endif
+!!$
+!!$      call psb_realloc(isz,v,info,pad=pad)
+!!$      if (info /= psb_success_) then
+!!$        info=psb_err_from_subroutine_
+!!$        call psb_errpush(info,name,a_err='psb_realloc')
+!!$        goto 9999
+!!$      End If
+!!$    end If
    If (len > psb_size(v)) Then
+#if defined(OPENMP)
+      !$OMP CRITICAL
+      if (len > psb_size(v)) then
+        if (present(newsz)) then
+          isz = (max(len+1,newsz))
+        else
+          if (present(addsz)) then
+            isz = len+max(1,addsz)
+          else
+            isz = max(len+10, int(1.25*len))
+          endif
+        endif
+
+        call psb_realloc(isz,v,info,pad=pad)
+      end if
+      !$OMP END CRITICAL
+
+      if (info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        call psb_errpush(info,name,a_err='psb_realloc')
+	goto 9999
+      end if
+#else
      if (present(newsz)) then 
        isz = (max(len+1,newsz))
      else
@ -999,6 +1040,7 @@ Contains
        call psb_errpush(info,name,a_err='psb_realloc')
        goto 9999
      End If
+#endif
    end If

    call psb_erractionrestore(err_act)
--- a/base/modules/auxil/psb_d_realloc_mod.F90
+++ b/base/modules/auxil/psb_d_realloc_mod.F90
@ -982,7 +982,48 @@ Contains
      goto 9999
    end if

+!!$    If (len > psb_size(v)) Then
+!!$      if (present(newsz)) then 
+!!$        isz = (max(len+1,newsz))
+!!$      else
+!!$        if (present(addsz)) then 
+!!$          isz = len+max(1,addsz)
+!!$        else
+!!$          isz = max(len+10, int(1.25*len))
+!!$        endif
+!!$      endif
+!!$
+!!$      call psb_realloc(isz,v,info,pad=pad)
+!!$      if (info /= psb_success_) then
+!!$        info=psb_err_from_subroutine_
+!!$        call psb_errpush(info,name,a_err='psb_realloc')
+!!$        goto 9999
+!!$      End If
+!!$    end If
    If (len > psb_size(v)) Then
+#if defined(OPENMP)
+      !$OMP CRITICAL
+      if (len > psb_size(v)) then
+        if (present(newsz)) then
+          isz = (max(len+1,newsz))
+        else
+          if (present(addsz)) then
+            isz = len+max(1,addsz)
+          else
+            isz = max(len+10, int(1.25*len))
+          endif
+        endif
+
+        call psb_realloc(isz,v,info,pad=pad)
+      end if
+      !$OMP END CRITICAL
+
+      if (info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        call psb_errpush(info,name,a_err='psb_realloc')
+	goto 9999
+      end if
+#else
      if (present(newsz)) then 
        isz = (max(len+1,newsz))
      else
@ -999,6 +1040,7 @@ Contains
        call psb_errpush(info,name,a_err='psb_realloc')
        goto 9999
      End If
+#endif
    end If

    call psb_erractionrestore(err_act)
--- a/base/modules/auxil/psb_e_realloc_mod.F90
+++ b/base/modules/auxil/psb_e_realloc_mod.F90
@ -982,7 +982,48 @@ Contains
      goto 9999
    end if

+!!$    If (len > psb_size(v)) Then
+!!$      if (present(newsz)) then 
+!!$        isz = (max(len+1,newsz))
+!!$      else
+!!$        if (present(addsz)) then 
+!!$          isz = len+max(1,addsz)
+!!$        else
+!!$          isz = max(len+10, int(1.25*len))
+!!$        endif
+!!$      endif
+!!$
+!!$      call psb_realloc(isz,v,info,pad=pad)
+!!$      if (info /= psb_success_) then
+!!$        info=psb_err_from_subroutine_
+!!$        call psb_errpush(info,name,a_err='psb_realloc')
+!!$        goto 9999
+!!$      End If
+!!$    end If
    If (len > psb_size(v)) Then
+#if defined(OPENMP)
+      !$OMP CRITICAL
+      if (len > psb_size(v)) then
+        if (present(newsz)) then
+          isz = (max(len+1,newsz))
+        else
+          if (present(addsz)) then
+            isz = len+max(1,addsz)
+          else
+            isz = max(len+10, int(1.25*len))
+          endif
+        endif
+
+        call psb_realloc(isz,v,info,pad=pad)
+      end if
+      !$OMP END CRITICAL
+
+      if (info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        call psb_errpush(info,name,a_err='psb_realloc')
+	goto 9999
+      end if
+#else
      if (present(newsz)) then 
        isz = (max(len+1,newsz))
      else
@ -999,6 +1040,7 @@ Contains
        call psb_errpush(info,name,a_err='psb_realloc')
        goto 9999
      End If
+#endif
    end If

    call psb_erractionrestore(err_act)
--- a/base/modules/auxil/psb_i2_realloc_mod.F90
+++ b/base/modules/auxil/psb_i2_realloc_mod.F90
@ -982,7 +982,48 @@ Contains
      goto 9999
    end if

+!!$    If (len > psb_size(v)) Then
+!!$      if (present(newsz)) then 
+!!$        isz = (max(len+1,newsz))
+!!$      else
+!!$        if (present(addsz)) then 
+!!$          isz = len+max(1,addsz)
+!!$        else
+!!$          isz = max(len+10, int(1.25*len))
+!!$        endif
+!!$      endif
+!!$
+!!$      call psb_realloc(isz,v,info,pad=pad)
+!!$      if (info /= psb_success_) then
+!!$        info=psb_err_from_subroutine_
+!!$        call psb_errpush(info,name,a_err='psb_realloc')
+!!$        goto 9999
+!!$      End If
+!!$    end If
    If (len > psb_size(v)) Then
+#if defined(OPENMP)
+      !$OMP CRITICAL
+      if (len > psb_size(v)) then
+        if (present(newsz)) then
+          isz = (max(len+1,newsz))
+        else
+          if (present(addsz)) then
+            isz = len+max(1,addsz)
+          else
+            isz = max(len+10, int(1.25*len))
+          endif
+        endif
+
+        call psb_realloc(isz,v,info,pad=pad)
+      end if
+      !$OMP END CRITICAL
+
+      if (info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        call psb_errpush(info,name,a_err='psb_realloc')
+	goto 9999
+      end if
+#else
      if (present(newsz)) then 
        isz = (max(len+1,newsz))
      else
@ -999,6 +1040,7 @@ Contains
        call psb_errpush(info,name,a_err='psb_realloc')
        goto 9999
      End If
+#endif
    end If

    call psb_erractionrestore(err_act)
--- a/base/modules/auxil/psb_m_realloc_mod.F90
+++ b/base/modules/auxil/psb_m_realloc_mod.F90
@ -982,7 +982,48 @@ Contains
      goto 9999
    end if

+!!$    If (len > psb_size(v)) Then
+!!$      if (present(newsz)) then 
+!!$        isz = (max(len+1,newsz))
+!!$      else
+!!$        if (present(addsz)) then 
+!!$          isz = len+max(1,addsz)
+!!$        else
+!!$          isz = max(len+10, int(1.25*len))
+!!$        endif
+!!$      endif
+!!$
+!!$      call psb_realloc(isz,v,info,pad=pad)
+!!$      if (info /= psb_success_) then
+!!$        info=psb_err_from_subroutine_
+!!$        call psb_errpush(info,name,a_err='psb_realloc')
+!!$        goto 9999
+!!$      End If
+!!$    end If
    If (len > psb_size(v)) Then
+#if defined(OPENMP)
+      !$OMP CRITICAL
+      if (len > psb_size(v)) then
+        if (present(newsz)) then
+          isz = (max(len+1,newsz))
+        else
+          if (present(addsz)) then
+            isz = len+max(1,addsz)
+          else
+            isz = max(len+10, int(1.25*len))
+          endif
+        endif
+
+        call psb_realloc(isz,v,info,pad=pad)
+      end if
+      !$OMP END CRITICAL
+
+      if (info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        call psb_errpush(info,name,a_err='psb_realloc')
+	goto 9999
+      end if
+#else
      if (present(newsz)) then 
        isz = (max(len+1,newsz))
      else
@ -999,6 +1040,7 @@ Contains
        call psb_errpush(info,name,a_err='psb_realloc')
        goto 9999
      End If
+#endif
    end If

    call psb_erractionrestore(err_act)
--- a/base/modules/auxil/psb_s_realloc_mod.F90
+++ b/base/modules/auxil/psb_s_realloc_mod.F90
@ -982,7 +982,48 @@ Contains
      goto 9999
    end if

+!!$    If (len > psb_size(v)) Then
+!!$      if (present(newsz)) then 
+!!$        isz = (max(len+1,newsz))
+!!$      else
+!!$        if (present(addsz)) then 
+!!$          isz = len+max(1,addsz)
+!!$        else
+!!$          isz = max(len+10, int(1.25*len))
+!!$        endif
+!!$      endif
+!!$
+!!$      call psb_realloc(isz,v,info,pad=pad)
+!!$      if (info /= psb_success_) then
+!!$        info=psb_err_from_subroutine_
+!!$        call psb_errpush(info,name,a_err='psb_realloc')
+!!$        goto 9999
+!!$      End If
+!!$    end If
    If (len > psb_size(v)) Then
+#if defined(OPENMP)
+      !$OMP CRITICAL
+      if (len > psb_size(v)) then
+        if (present(newsz)) then
+          isz = (max(len+1,newsz))
+        else
+          if (present(addsz)) then
+            isz = len+max(1,addsz)
+          else
+            isz = max(len+10, int(1.25*len))
+          endif
+        endif
+
+        call psb_realloc(isz,v,info,pad=pad)
+      end if
+      !$OMP END CRITICAL
+
+      if (info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        call psb_errpush(info,name,a_err='psb_realloc')
+	goto 9999
+      end if
+#else
      if (present(newsz)) then 
        isz = (max(len+1,newsz))
      else
@ -999,6 +1040,7 @@ Contains
        call psb_errpush(info,name,a_err='psb_realloc')
        goto 9999
      End If
+#endif
    end If

    call psb_erractionrestore(err_act)
--- a/base/modules/auxil/psb_z_realloc_mod.F90
+++ b/base/modules/auxil/psb_z_realloc_mod.F90
@ -982,7 +982,48 @@ Contains
      goto 9999
    end if

+!!$    If (len > psb_size(v)) Then
+!!$      if (present(newsz)) then 
+!!$        isz = (max(len+1,newsz))
+!!$      else
+!!$        if (present(addsz)) then 
+!!$          isz = len+max(1,addsz)
+!!$        else
+!!$          isz = max(len+10, int(1.25*len))
+!!$        endif
+!!$      endif
+!!$
+!!$      call psb_realloc(isz,v,info,pad=pad)
+!!$      if (info /= psb_success_) then
+!!$        info=psb_err_from_subroutine_
+!!$        call psb_errpush(info,name,a_err='psb_realloc')
+!!$        goto 9999
+!!$      End If
+!!$    end If
    If (len > psb_size(v)) Then
+#if defined(OPENMP)
+      !$OMP CRITICAL
+      if (len > psb_size(v)) then
+        if (present(newsz)) then
+          isz = (max(len+1,newsz))
+        else
+          if (present(addsz)) then
+            isz = len+max(1,addsz)
+          else
+            isz = max(len+10, int(1.25*len))
+          endif
+        endif
+
+        call psb_realloc(isz,v,info,pad=pad)
+      end if
+      !$OMP END CRITICAL
+
+      if (info /= psb_success_) then
+        info=psb_err_from_subroutine_
+        call psb_errpush(info,name,a_err='psb_realloc')
+	goto 9999
+      end if
+#else
      if (present(newsz)) then 
        isz = (max(len+1,newsz))
      else
@ -999,6 +1040,7 @@ Contains
        call psb_errpush(info,name,a_err='psb_realloc')
        goto 9999
      End If
+#endif
    end If

    call psb_erractionrestore(err_act)