inipar.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "r4r8_p.inc"
#include "spmd.inc"
#include "com01_c.inc"
#include "task_c.inc"
#include "scr05_c.inc"
#include "units_c.inc"
#include "commandline.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	inipar (coupling, itid, icas, nnodes, input, got_input, nbtask)

Function/Subroutine Documentation

inipar()

subroutine inipar	(	type(coupling_type), intent(inout)	coupling,
		integer, dimension(*)	itid,
		integer	icas,
		integer	nnodes,
		character*100	input,
		integer	got_input,
		integer, dimension(*)	nbtask )

Definition at line 375 of file inipar.F.

C-----------------------------------------------------------------
        USE spmd_comm_world_mod, ONLY : spmd_comm_world
        USE coupling_adapter_mod
#include      "implicit_f.inc"
#include      "comlock.inc"
#include      "r4r8_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ITID(*),ICAS, NNODES,GOT_INPUT,NBTASK(*)
      CHARACTER*100 INPUT
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include "spmd.inc"
#include  "com01_c.inc"
#include  "task_c.inc"
#include  "scr05_c.inc"
#include  "units_c.inc"
#include  "commandline.inc"
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      type(coupling_type), intent(inout) :: coupling
      INTEGER ICODE, I, NTHREAD1
#if defined(_OPENMP)
      INTEGER OMP_GET_MAX_THREADS
#endif
      CHARACTER (LEN=255) :: STR
C--------------------------------------------------
C     CONVENTIONS:
C                  ispmd 0...NSPMD-1
C--------------------------------------------------
      IF(icas==1) THEN
C
        REAL = 4
        IF(ir4r8==2) real = 8
C
        nnodes= 1
        ispmd = 0
#if defined(_OPENMP)
        str = ' '
        CALL  getenv('OMP_NUM_THREADS',str)
        nthread1=0
C nthread1 : nombre de threads fixe par la variable environnememt
        READ(str,'(I10)',err=999)nthread1
        GOTO 1000
 999    CONTINUE
        nthread1 = -1
 1000   CONTINUE
        IF(nthread1>0)THEN
          nthread=nthread1
        ELSE
          nthread=nthread0 ! defaut run precedent
        END IF
        IF (got_nth == 1) THEN
          IF (nthread>1 .AND. (nth/= nthread .OR. (nth==nthread .AND.
     +        nthread1>0.AND.nthread0>1.AND.nthread1/=nthread0)))THEN
            WRITE(iout,*)
     +    '** WARNING : -nthread OPTION USED, DEFAULT SETTING IGNORED'
            WRITE(iout,*)' '
          END IF
          nthread = nth
        ELSE
          IF(nthread1>0.AND.nthread0>1.AND.nthread1/=nthread0)THEN
              WRITE(iout,*)
     +    '** WARNING : OMP_NUM_THREADS SET, DEFAULT SETTING IGNORED'
              WRITE(iout,*)' '
          END IF
        ENDIF
        IF(nthread<=0)  nthread=1
        IF(nthread>nthmax) nthread=nthmax
C
#elif 1
        nthread = 1
#endif
      ELSE IF(icas==3) THEN
C
        IF (nspmd /= nnodes) THEN
          WRITE(iout,*)
     .    'NON HYBRID EXECUTABLE ONLY SUPPORTS ONE SPMD DOMAIN'
          WRITE(iout,*)
     .    'PLEASE, RUN STARTER WITH -nspmd 1 OR USE HMPP EXECUTABLE'
          WRITE(iout,*)
     .        'REQUIRED (number of .rst files) NSPMD =',nspmd
          WRITE(iout,*)
     .        'AVAILABLE                             =',nnodes
          WRITE(iout,*)' '
          WRITE(istdo,*)
     .    'NON HYBRID EXECUTABLE ONLY SUPPORTS ONE SPMD DOMAIN'
          WRITE(istdo,*)
     .    'PLEASE, RUN STARTER WITH -nspmd 1 OR USE HMPP EXECUTABLE'
          WRITE(istdo,*)' '
          WRITE(iout,*)
     .             ' E R R O R     T E R M I N A T I O N'
          WRITE(istdo,*)
     .             ' E R R O R     T E R M I N A T I O N'
          WRITE(iout,*)
     .             ' TOTAL NUMBER OF CYCLES  :', ncycle
          WRITE(istdo,*)
     .             ' TOTAL NUMBER OF CYCLES  :', ncycle
          icode=2
          CALL arret(7)
C
        ENDIF
        nbtask(1)=nthread
        nbtask(2)=nthread
#if defined(_OPENMP)
        CALL omp_set_num_threads(nthread)
        DO i = 1, 2*intseg
          CALL omp_init_lock(llock(1,i))
        ENDDO
#endif
      ELSE IF(icas==2) THEN
#if defined(_OPENMP)
#endif
      ENDIF
      RETURN