summaryrefslogtreecommitdiff
path: root/Ganlib/src/LCMNOD.f
diff options
context:
space:
mode:
Diffstat (limited to 'Ganlib/src/LCMNOD.f')
-rw-r--r--Ganlib/src/LCMNOD.f203
1 files changed, 203 insertions, 0 deletions
diff --git a/Ganlib/src/LCMNOD.f b/Ganlib/src/LCMNOD.f
new file mode 100644
index 0000000..11558bd
--- /dev/null
+++ b/Ganlib/src/LCMNOD.f
@@ -0,0 +1,203 @@
+*DECK LCMNOD
+ SUBROUTINE LCMNOD(NUNIT,IMODE,IDIR,JLONG,ITYLCM,PT_DATA)
+*
+*-----------------------------------------------------------------------
+*
+*Purpose:
+* Export/import a single node. Called by LCMEXP.
+*
+*Copyright:
+* Copyright (C) 1993 Ecole Polytechnique de Montreal
+* This library is free software; you can redistribute it and/or
+* modify it under the terms of the GNU Lesser General Public
+* License as published by the Free Software Foundation; either
+* version 2.1 of the License, or (at your option) any later version
+*
+*Author(s): A. Hebert
+*
+*Parameters: input
+* NUNIT file unit number where the export/import is performed.
+* IMODE type of export/import file (=1 sequential unformatted;
+* =2 sequential formatted -- ascii).
+* IDIR export-import flag(=1 to export ; =2 to import).
+* JLONG node length.
+* ITYLCM node type.
+* PT_DATA c_ptr address of data.
+*
+*-----------------------------------------------------------------------
+*
+ USE GANLIB
+*----
+* SUBROUTINE ARGUMENTS
+*----
+ INTEGER :: NUNIT,IMODE,IDIR,JLONG,ITYLCM
+ TYPE(C_PTR) :: PT_DATA
+*----
+* LOCAL VARIABLES
+*----
+ PARAMETER (NBLK=24,LENDAT=4)
+ INTEGER, POINTER :: III(:)
+ REAL, POINTER :: RRR(:)
+ LOGICAL, POINTER :: LLL(:)
+ DOUBLE PRECISION, POINTER :: DDD(:)
+ COMPLEX, POINTER :: CCC(:)
+*
+ IF(IDIR.EQ.1) THEN
+* EXPORT A NODE.
+ IF(ITYLCM.EQ.1) THEN
+* INTEGER DATA.
+ CALL C_F_POINTER(PT_DATA, III, (/ JLONG /))
+ DO 40 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ WRITE(NUNIT) (III((I-1)*NBLK+J),J=1,JMIN)
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ WRITE(NUNIT,'(8I10)') (III((I-1)*NBLK+J),J=1,JMIN)
+ ENDIF
+ 40 CONTINUE
+ ELSE IF(ITYLCM.EQ.2) THEN
+* SINGLE PRECISION DATA.
+ CALL C_F_POINTER(PT_DATA, RRR, (/ JLONG /))
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ DO 50 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ WRITE(NUNIT) (RRR((I-1)*NBLK+J),J=1,JMIN)
+ 50 CONTINUE
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ WRITE(NUNIT,'(1P,5E16.8)') (RRR(I),I=1,JLONG)
+ ENDIF
+ ELSE IF(ITYLCM.EQ.3) THEN
+* CHARACTER*4 DATA.
+ CALL C_F_POINTER(PT_DATA, III, (/ JLONG /))
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ DO 60 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ WRITE(NUNIT) (LENDAT,K=1,JMIN)
+ 60 CONTINUE
+ DO 70 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ WRITE(NUNIT) (III((I-1)*NBLK+J),J=1,JMIN)
+ 70 CONTINUE
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ WRITE(NUNIT,'(8I10)') (LENDAT,I=1,JLONG)
+ WRITE(NUNIT,'(20A4)') (III(I),I=1,JLONG)
+ ENDIF
+ ELSE IF(ITYLCM.EQ.4) THEN
+* DOUBLE PRECISION DATA.
+ CALL C_F_POINTER(PT_DATA, DDD, (/ JLONG /))
+ DO 90 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ WRITE(NUNIT) (DDD((I-1)*NBLK+J),J=1,JMIN)
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ WRITE(NUNIT,'(1P,4D20.12)') (DDD((I-1)*NBLK+J),J=1,JMIN)
+ ENDIF
+ 90 CONTINUE
+ ELSE IF(ITYLCM.EQ.5) THEN
+* LOGICAL DATA.
+ CALL C_F_POINTER(PT_DATA, LLL, (/ JLONG /))
+ DO 110 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ WRITE(NUNIT) (LLL((I-1)*NBLK+J),J=1,JMIN)
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ WRITE(NUNIT,'(8L10)') (LLL((I-1)*NBLK+J),J=1,JMIN)
+ ENDIF
+ 110 CONTINUE
+ ELSE IF(ITYLCM.EQ.6) THEN
+* COMPLEX DATA.
+ CALL C_F_POINTER(PT_DATA, CCC, (/ JLONG /))
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ DO 120 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ WRITE(NUNIT) (CCC((I-1)*NBLK+J),J=1,JMIN)
+ 120 CONTINUE
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ WRITE(NUNIT,'(1P,5E16.8)') (CCC(I),I=1,JLONG)
+ ENDIF
+ ENDIF
+ ELSE IF(IDIR.EQ.2) THEN
+* IMPORT A NODE.
+ IF(ITYLCM.EQ.1) THEN
+* INTEGER DATA.
+ CALL C_F_POINTER(PT_DATA, III, (/ JLONG /))
+ DO 190 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ READ(NUNIT) (III((I-1)*NBLK+J),J=1,JMIN)
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ READ(NUNIT,'(8I10)') (III((I-1)*NBLK+J),J=1,JMIN)
+ ENDIF
+ 190 CONTINUE
+ ELSE IF(ITYLCM.EQ.2) THEN
+* SINGLE PRECISION DATA.
+ CALL C_F_POINTER(PT_DATA, RRR, (/ JLONG /))
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ DO 200 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ READ(NUNIT) (RRR((I-1)*NBLK+J),J=1,JMIN)
+ 200 CONTINUE
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ READ(NUNIT,'(5E16.0)') (RRR(I),I=1,JLONG)
+ ENDIF
+ ELSE IF(ITYLCM.EQ.3) THEN
+* CHARACTER*4 DATA.
+ CALL C_F_POINTER(PT_DATA, III, (/ JLONG /))
+ KLONG=0
+ DO 215 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ READ(NUNIT) (III((I-1)*NBLK+J),J=1,JMIN)
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ READ(NUNIT,'(8I10)') (III((I-1)*NBLK+J),J=1,JMIN)
+ ENDIF
+ DO 210 J=1,JMIN
+ KLONG=KLONG+III(J)
+ 210 CONTINUE
+ 215 CONTINUE
+ IF((KLONG+3)/4.GT.JLONG) CALL XABORT('LCMNOD: OVERFLOW.')
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ DO 220 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ READ(NUNIT) (III((I-1)*NBLK+J),J=1,JMIN)
+ 220 CONTINUE
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ READ(NUNIT,'(20A4)') (III(I),I=1,JLONG)
+ ENDIF
+ ELSE IF(ITYLCM.EQ.4) THEN
+* DOUBLE PRECISION DATA.
+ CALL C_F_POINTER(PT_DATA, DDD, (/ JLONG /))
+ DO 230 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ READ(NUNIT) (DDD((I-1)*NBLK+J),J=1,JMIN)
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ READ(NUNIT,'(4D20.0)') (DDD((I-1)*NBLK+J),J=1,JMIN)
+ ENDIF
+ 230 CONTINUE
+ ELSE IF(ITYLCM.EQ.5) THEN
+* LOGICAL DATA.
+ CALL C_F_POINTER(PT_DATA, LLL, (/ JLONG /))
+ DO 240 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ READ(NUNIT) (LLL((I-1)*NBLK+J),J=1,JMIN)
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ READ(NUNIT,'(8L10)') (LLL((I-1)*NBLK+J),J=1,JMIN)
+ ENDIF
+ 240 CONTINUE
+ ELSE IF(ITYLCM.EQ.6) THEN
+* COMPLEX DATA.
+ CALL C_F_POINTER(PT_DATA, CCC, (/ JLONG /))
+ IF((NUNIT.NE.0).AND.(IMODE.EQ.1)) THEN
+ DO 250 I=1,1+(JLONG-1)/NBLK
+ JMIN=MIN(NBLK,JLONG-(I-1)*NBLK)
+ READ(NUNIT) (CCC((I-1)*NBLK+J),J=1,JMIN)
+ 250 CONTINUE
+ ELSE IF((NUNIT.NE.0).AND.(IMODE.EQ.2)) THEN
+ READ(NUNIT,'(5E16.0)') (CCC(I),I=1,JLONG)
+ ENDIF
+ ENDIF
+ ENDIF
+ RETURN
+ END
generated by cgit v1.2.3 (git 2.46.0) at 2026-02-16 11:15:44 +0000