diff --git a/.github/tools/install-intel-oneapi.sh b/.github/tools/install-intel-oneapi.sh index 78af1aec..b6db3853 100755 --- a/.github/tools/install-intel-oneapi.sh +++ b/.github/tools/install-intel-oneapi.sh @@ -1,14 +1,14 @@ -#!/bin/sh +#!/usr/bin/env bash -KEY=GPG-PUB-KEY-INTEL-SW-PRODUCTS-2023.PUB +version=2023.2.0 +KEY=GPG-PUB-KEY-INTEL-SW-PRODUCTS.PUB wget https://apt.repos.intel.com/intel-gpg-keys/$KEY sudo apt-key add $KEY rm $KEY echo "deb https://apt.repos.intel.com/oneapi all main" | sudo tee /etc/apt/sources.list.d/oneAPI.list sudo apt-get update sudo apt-get install \ - intel-oneapi-compiler-fortran \ - intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic \ - intel-oneapi-mpi \ - intel-oneapi-mpi-devel \ - intel-oneapi-mkl + intel-oneapi-compiler-fortran-$version \ + intel-oneapi-compiler-dpcpp-cpp-and-cpp-classic-$version \ + intel-oneapi-mpi-devel-2021.10.0 \ + intel-oneapi-mkl-$version diff --git a/.github/tools/install-mpi.sh b/.github/tools/install-mpi.sh index 03a5e3a3..c5c1847a 100755 --- a/.github/tools/install-mpi.sh +++ b/.github/tools/install-mpi.sh @@ -62,6 +62,8 @@ case "$os" in openmpi) brew ls --versions openmpi || brew install openmpi echo "localhost slots=72" >> $(brew --prefix)/etc/openmpi-default-hostfile + echo "localhost slots=72" >> $(brew --prefix)/etc/prte-default-hostfile + # workaround for open-mpi/omp#7516 echo "setting the mca gds to hash..." echo "gds = hash" >> $(brew --prefix)/etc/pmix-mca-params.conf diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 38d0198e..d77c66b9 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -34,7 +34,7 @@ jobs: - linux gnu-10 - linux clang-12 - linux nvhpc-21.9 - - linux intel + - linux intel-classic - macos include: @@ -73,9 +73,9 @@ jobs: cmake_options: -DCMAKE_CXX_FLAGS=--diag_suppress177 caching: false - - name : linux intel + - name : linux intel-classic os: ubuntu-20.04 - compiler: intel-oneapi + compiler: intel-classic compiler_cc: icc compiler_cxx: icpc compiler_fc: ifort @@ -136,7 +136,7 @@ jobs: ${FIAT_TOOLS}/install-intel-oneapi.sh source /opt/intel/oneapi/setvars.sh printenv >> $GITHUB_ENV - echo "CACHE_SUFFIX=$(icc -dumpversion)" >> $GITHUB_ENV + echo "CACHE_SUFFIX=$CC-$($CC -dumpversion)" >> $GITHUB_ENV - name: Install MPI shell: bash -eux {0} diff --git a/VERSION b/VERSION index 26aaba0e..f0bb29e7 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.2.0 +1.3.0 diff --git a/src/fiat/drhook/dr_hook_init.F90 b/src/fiat/drhook/dr_hook_init.F90 index 3e13abd9..63ced2c8 100644 --- a/src/fiat/drhook/dr_hook_init.F90 +++ b/src/fiat/drhook/dr_hook_init.F90 @@ -74,6 +74,7 @@ SUBROUTINE DR_HOOK_ASSERT_MPI_INITIALIZED_() CMPIRUN_DETECT(2) = 'ALPS_APP_PE' ! Cray PE CMPIRUN_DETECT(3) = 'PMI_SIZE' ! Intel CMPIRUN_DETECT(4) = 'SLURM_STEP_NUM_TASKS' ! Slurm + ! When adding here, change NVARS parameter above LMPI_REQUIRED = .FALSE. DO IVAR=1,NVARS diff --git a/src/fiat/drhook/drhook.c b/src/fiat/drhook/drhook.c index 6ef8e682..186ec63f 100644 --- a/src/fiat/drhook/drhook.c +++ b/src/fiat/drhook/drhook.c @@ -4152,7 +4152,6 @@ c_drhook_print_(const int *ftnunitno, int nprof = 0; drhook_prof_t *prof = NULL; drhook_prof_t *p; - double flop_tot = 0, instr_tot = 0; double *flop = NULL, *instr = NULL; if (!opt_wallprof && !opt_cpuprof) return; /* no profiling info available */ @@ -4332,12 +4331,8 @@ c_drhook_print_(const int *ftnunitno, p = prof; qsort(p, nprof, sizeof(*p), prof_pc_comp_desc); - flop_tot = 0; - instr_tot = 0; max_overhead_pc = 0; for (t=0; t) - CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZHOOK_HANDLE(1:INUMTH)) - ELSEIF(CCTYPE(KNUM).EQ.'BAR')THEN - CALL DR_HOOK(CCDESC_DRHOOK(KNUM),KSWITCH,ZHOOK_HANDLE_BARR) + IF (CCTYPE(KNUM) .EQ. "TRS") THEN + CALL DR_HOOK(CCDESC_DRHOOK(KNUM), KSWITCH, ZHOOK_HANDLE_TRANS) + ELSEIF (CCTYPE(KNUM) .EQ. 'MP-') THEN + CALL DR_HOOK(CCDESC_DRHOOK(KNUM), KSWITCH, ZHOOK_HANDLE_COMMS) + ELSEIF (CCTYPE(KNUM) .EQ. 'MPL' .AND. KNUM .NE. 682) THEN + CALL DR_HOOK(CCDESC_DRHOOK(KNUM), KSWITCH, ZHOOK_HANDLE_COMMS1) + ELSEIF (CCTYPE(KNUM) .EQ. 'OMP') THEN + ! The prevailing number of threads -- could now be less than the absolute max (i.e. export + ! OMP_NUM_THREADS=) + INUMTH = OML_MAX_THREADS() + CALL DR_HOOK(CCDESC_DRHOOK(KNUM), KSWITCH, ZHOOK_HANDLE(1:INUMTH)) + ELSEIF (CCTYPE(KNUM) .EQ. 'BAR')THEN + CALL DR_HOOK(CCDESC_DRHOOK(KNUM), KSWITCH, ZHOOK_HANDLE_BARR) ENDIF -! measure GSTATS HOOK overhead + ! Measure GSTATS HOOK overhead CALL USER_CLOCK(PELAPSED_TIME=ZCLOCK1) - TIMESUM(401) = TIMESUM(401)+ZCLOCK1-ZCLOCK - NCALLS(401) = NCALLS(401)+1 - ZCLOCK=ZCLOCK1 + TIMESUM(401) = TIMESUM(401) + ZCLOCK1 - ZCLOCK + NCALLS(401) = NCALLS(401) + 1 + ZCLOCK = ZCLOCK1 ENDIF IF (LLFIRST) THEN -! write(0,*) "JPMAXSTAT:2=",JPMAXSTAT - NSWITCHVAL(:) = -1 TIMESQSUM(:) = 0.0_JPRD TIMEMAX(:) = 0.0_JPRD TIMESUMB(:) = 0.0_JPRD - IF( LLFINDSUMB )THEN - ISUMBSTACK(:)=0 + IF (LLFINDSUMB) THEN + ISUMBSTACK(:) = 0 ENDIF TTCPUSUM(:) = 0.0_JPRD TVCPUSUM(:) = 0.0_JPRD TIMELCALL(:) = ZCLOCK - CCDESC="" - CCTYPE="" - NTMEM = 0 + CCDESC = "" + CCTYPE = "" + NTMEM = 0 NTMEM(:,5) = 99999999 - IIMEM=0 - IIPAG=0 - IIMEMC=0 + IIMEM = 0 + IIPAG = 0 + IIMEMC = 0 TIME_LAST_CALL = ZCLOCK LLFIRST = .FALSE. ENDIF - IF(KNUM < 0.OR. KNUM > JPMAXSTAT) CALL ABOR1('GSTATS') - IF(KSWITCH == 0.OR. KSWITCH == 1) THEN - NCALLS(KNUM) = NCALLS(KNUM)+1 + ! Check KNUM is valid (> 0 and < JPMAXSTAT) + IF (KNUM < 0) CALL ABOR1('GSTATS: KNUM cannot be negative') + IF (KNUM > JPMAXSTAT) THEN + WRITE(CL_MAXSTAT,'(I4)') JPMAXSTAT + CALL ABOR1('GSTATS: KNUM cannot be greater than ' // CL_MAXSTAT) ENDIF - IMOD = MOD(NCALLS(KNUM),2) - IF(.NOT.((KSWITCH == 0.AND. IMOD == 1) .OR.& - &(KSWITCH == 2.AND. IMOD == 1) .OR.& - &(KSWITCH == 3.AND. IMOD == 1) .OR.& - &(KSWITCH == 1.AND. IMOD == 0))) THEN - WRITE(JPERR,*) 'KNUM,KSWITCH,IMOD,NCALLS(KNUM)',& - &KNUM,KSWITCH,IMOD,NCALLS(KNUM) - CALL ABOR1('GSTATS') + + IF (KSWITCH == 0 .OR. KSWITCH == 1) THEN + NCALLS(KNUM) = NCALLS(KNUM) + 1 ENDIF + IMOD = MOD(NCALLS(KNUM), 2) -! WRITE(0,'("GSTATS(SUMB): ",I4,2X,I1,2X,A40)') KNUM,KSWITCH,CCDESC(KNUM) + ! Check we haven't opened or closed a region twice in a row + IF (.NOT.((KSWITCH == 0 .AND. IMOD == 1) .OR. (KSWITCH == 2 .AND. IMOD == 1) .OR. & + & (KSWITCH == 3 .AND. IMOD == 1) .OR. (KSWITCH == 1 .AND. IMOD == 0))) THEN + WRITE(CL_ERROR_MESSAGE,'(A42,I4)') "Invalid GSTATS call - check region KNUM = ", KNUM + CALL ABOR1('GSTATS: ' // CL_ERROR_MESSAGE) + ENDIF - NSWITCHVAL(KNUM)=KSWITCH + NSWITCHVAL(KNUM) = KSWITCH - IF( KSWITCH == 0 ) THEN -! Start timing event - IF(KNUM>=500)THEN - ZTIMED = ZCLOCK-TIME_LAST_CALL - TIMESUMB(KNUM) = TIMESUMB(KNUM)+ZTIMED + IF (KSWITCH == 0) THEN + ! Start timing event + IF (KNUM >= 500) THEN + ZTIMED = ZCLOCK - TIME_LAST_CALL + TIMESUMB(KNUM) = TIMESUMB(KNUM) + ZTIMED ELSE ZTIMED = 0.0_JPRD ENDIF - IF( LLFINDSUMB .AND. MYPROC_STATS <= 2 )THEN -! diagnostic code to find source of sumb (this should only be activated temporarily) - DO J=9,1,-1 - ISUMBSTACK(J+1)=ISUMBSTACK(J) + IF (LLFINDSUMB .AND. MYPROC_STATS <= 2)THEN + ! Diagnostic code to find source of sumb (this should only be activated temporarily) + DO J = 9, 1, -1 + ISUMBSTACK(J+1) = ISUMBSTACK(J) ENDDO - ISUMBSTACK(1)=KNUM - IF( ZTIMED > 0.1_JPRD .AND. (TIMESUMB(KNUM) > 1.0_JPRD) )THEN - WRITE(0,'("GSTATS(SUMB): KNUM=",I4," ZTIMED=",F10.6," TIMESUMB=",F10.6)')& - & KNUM,ZTIMED,TIMESUMB(KNUM) - DO J=1,10 - IF( ISUMBSTACK(J) > 0 )THEN - WRITE(0,'("GSTATS(SUMB): ",I4,2X,I8,2X,A40)')ISUMBSTACK(J),& - & NCALLS(ISUMBSTACK(J)),CCDESC(ISUMBSTACK(J)) + ISUMBSTACK(1) = KNUM + IF (ZTIMED > 0.1_JPRD .AND. (TIMESUMB(KNUM) > 1.0_JPRD)) THEN + WRITE(0,'("GSTATS(SUMB): KNUM=",I4," ZTIMED=",F10.6," TIMESUMB=",F10.6)') & + & KNUM, ZTIMED, TIMESUMB(KNUM) + DO J = 1, 10 + IF (ISUMBSTACK(J) > 0) THEN + WRITE(0,'("GSTATS(SUMB): ",I4,2X,I8,2X,A40)') ISUMBSTACK(J), NCALLS(ISUMBSTACK(J)), & + & CCDESC(ISUMBSTACK(J)) ENDIF ENDDO ENDIF -! check if grouped counters are overlapping - DO J=0,JPMAXSTAT - IF( J /= KNUM )THEN - IF( CCTYPE(J )/=' '.AND.CCTYPE(J )/='TRS'.AND.CCTYPE(J )/='MP-' .AND.& - & CCTYPE(KNUM)/=' '.AND.CCTYPE(KNUM)/='TRS'.AND.CCTYPE(KNUM)/='MP-' )THEN - IF( NSWITCHVAL(J)==0.OR.NSWITCHVAL(J)==3 )THEN - WRITE(0,'("GSTATS(SUMB): OVERLAPPING COUNTERS ",I4,2X,I4)')KNUM,J + ! Check if grouped counters are overlapping + DO J = 0, JPMAXSTAT + IF (J /= KNUM)THEN + IF (CCTYPE(J ) /= ' ' .AND. CCTYPE(J ) /= 'TRS' .AND. CCTYPE(J ) /= 'MP-' .AND. & + & CCTYPE(KNUM) /= ' ' .AND. CCTYPE(KNUM) /= 'TRS' .AND. CCTYPE(KNUM) /= 'MP-') THEN + IF (NSWITCHVAL(J) == 0 .OR. NSWITCHVAL(J) == 3) THEN + WRITE(0,'("GSTATS(SUMB): OVERLAPPING COUNTERS ",I4,2X,I4)') KNUM, J ENDIF ENDIF ENDIF @@ -274,15 +261,15 @@ SUBROUTINE GSTATS(KNUM,KSWITCH) TVCPULCALL(KNUM) = ZVCPU THISTCPU(KNUM) = 0.0_JPRD THISVCPU(KNUM) = 0.0_JPRD - IF(MYPROC_STATS.LE.NSTATS_MEM.AND.MYPROC_STATS.NE.0) THEN - IMEM = GETMAXRSS()/1024 + IF (MYPROC_STATS .LE. NSTATS_MEM .AND. MYPROC_STATS .NE. 0) THEN + IMEM = GETMAXRSS() / 1024 IPAG = GETPAG() - IMEMH = GETHWM()/1024 - IMEMS = GETSTK()/1024 + IMEMH = GETHWM() / 1024 + IMEMS = GETSTK() / 1024 IMEMC = 0 - IF(LSTATS_ALLOC) IMEMC = GETCURHEAP()/1024 - IF(IMEM > IIMEM.OR.IPAG > IIPAG.OR.(LSTATS_ALLOC.AND.(IMEMC.NE.IIMEMC))) THEN - IF(LLMFIRST) THEN + IF (LSTATS_ALLOC) IMEMC = GETCURHEAP() / 1024 + IF (IMEM > IIMEM .OR. IPAG > IIPAG .OR. (LSTATS_ALLOC .AND. (IMEMC .NE. IIMEMC))) THEN + IF (LLMFIRST) THEN WRITE(0,*) ".---------------------------------------------------------" WRITE(0,*) "| Memory trace details" WRITE(0,*) "| --------------------" @@ -305,136 +292,127 @@ SUBROUTINE GSTATS(KNUM,KSWITCH) WRITE(0,'(A10,A5,21X,A7,2A8,A7,A5,A5,A8)') & & "MEMORY "," KNUM","RSS_INC"," RSS_MAX"," HEAP_MX"," STK", & & " PGS"," CALL"," HEAP" - LLMFIRST=.FALSE. + LLMFIRST = .FALSE. ENDIF WRITE(0,'(A10,I5,1X,A20,1X,I6,2(1X,I7),1X,I6,1X,I4,1X,I4,1X,I7)') & - & "MEMORY bfr",KNUM,CCDESC(KNUM),IMEM-IIMEM,IMEM,IMEMH,IMEMS, & - & IPAG-IIPAG,(NCALLS(KNUM)+1)/2,IMEMC + & "MEMORY bfr", KNUM, CCDESC(KNUM), IMEM - IIMEM, IMEM, IMEMH, IMEMS, IPAG - IIPAG, & + & (NCALLS(KNUM) + 1) / 2, IMEMC ENDIF - NTMEM(KNUM,2)=IMEM - IIMEM=IMEM - IIPAG=IPAG - IIMEMC=IMEMC + NTMEM(KNUM,2) = IMEM + IIMEM = IMEM + IIPAG = IPAG + IIMEMC = IMEMC ENDIF - IF(LSTATS_MPL.AND.CCTYPE(KNUM) .EQ. 'MPL') THEN - CALL MPL_STATSON(NSEND,SBYTES,NRECV,RBYTES) - UNKNOWN_NUMSEND(KNUM)=UNKNOWN_NUMSEND(KNUM)+NSEND - UNKNOWN_NUMRECV(KNUM)=UNKNOWN_NUMRECV(KNUM)+NRECV - UNKNOWN_SENDBYTES(KNUM)=UNKNOWN_SENDBYTES(KNUM)+SBYTES - UNKNOWN_RECVBYTES(KNUM)=UNKNOWN_RECVBYTES(KNUM)+RBYTES + IF (LSTATS_MPL .AND. CCTYPE(KNUM) .EQ. 'MPL') THEN + CALL MPL_STATSON(NSEND, SBYTES, NRECV, RBYTES) + UNKNOWN_NUMSEND(KNUM) = UNKNOWN_NUMSEND(KNUM) + NSEND + UNKNOWN_NUMRECV(KNUM) = UNKNOWN_NUMRECV(KNUM) + NRECV + UNKNOWN_SENDBYTES(KNUM) = UNKNOWN_SENDBYTES(KNUM) + SBYTES + UNKNOWN_RECVBYTES(KNUM) = UNKNOWN_RECVBYTES(KNUM) + RBYTES ENDIF - ELSEIF( KSWITCH == 1 ) THEN -! Finish timing event - ZTIME = THISTIME(KNUM)+(ZCLOCK-TIMELCALL(KNUM)) - IF(LSTATS_MPL.AND.CCTYPE(KNUM) .EQ. 'MPL') THEN - CALL MPL_STATSREAD(NSEND,SBYTES,NRECV,RBYTES) - NUMSEND(KNUM)=NUMSEND(KNUM)+NSEND - NUMRECV(KNUM)=NUMRECV(KNUM)+NRECV - SENDBYTES(KNUM)=SENDBYTES(KNUM)+SBYTES - RECVBYTES(KNUM)=RECVBYTES(KNUM)+RBYTES + ELSEIF (KSWITCH == 1) THEN + ! Finish timing event + ZTIME = THISTIME(KNUM) + (ZCLOCK - TIMELCALL(KNUM)) + IF (LSTATS_MPL .AND. CCTYPE(KNUM) .EQ. 'MPL') THEN + CALL MPL_STATSREAD(NSEND, SBYTES, NRECV, RBYTES) + NUMSEND(KNUM) = NUMSEND(KNUM) + NSEND + NUMRECV(KNUM) = NUMRECV(KNUM) + NRECV + SENDBYTES(KNUM) = SENDBYTES(KNUM) + SBYTES + RECVBYTES(KNUM) = RECVBYTES(KNUM) + RBYTES ENDIF - TIMESUM(KNUM) = TIMESUM(KNUM)+ZTIME - TIMESQSUM(KNUM) = TIMESQSUM(KNUM)+ZTIME**2 - TIMEMAX(KNUM) = MAX(TIMEMAX(KNUM),ZTIME) - TTCPUSUM(KNUM) = TTCPUSUM(KNUM)+THISTCPU(KNUM)+ZTCPU-TTCPULCALL(KNUM) - TVCPUSUM(KNUM) = TVCPUSUM(KNUM)+THISVCPU(KNUM)+ZVCPU-TVCPULCALL(KNUM) - IF(MYPROC_STATS.LE.NSTATS_MEM.AND.MYPROC_STATS.NE.0) THEN - IMEM = GETMAXRSS()/1024 + TIMESUM(KNUM) = TIMESUM(KNUM) + ZTIME + TIMESQSUM(KNUM) = TIMESQSUM(KNUM) + ZTIME ** 2 + TIMEMAX(KNUM) = MAX(TIMEMAX(KNUM), ZTIME) + TTCPUSUM(KNUM) = TTCPUSUM(KNUM) + THISTCPU(KNUM) + ZTCPU - TTCPULCALL(KNUM) + TVCPUSUM(KNUM) = TVCPUSUM(KNUM) + THISVCPU(KNUM) + ZVCPU - TVCPULCALL(KNUM) + IF (MYPROC_STATS .LE. NSTATS_MEM .AND. MYPROC_STATS .NE. 0) THEN + IMEM = GETMAXRSS() / 1024 IPAG = GETPAG() - IMEMH = GETHWM()/1024 - IMEMS = GETSTK()/1024 + IMEMH = GETHWM() / 1024 + IMEMS = GETSTK() / 1024 IMEMC = 0 - IF(LSTATS_ALLOC) IMEMC = GETCURHEAP()/1024 - IF(IMEM > IIMEM.OR.IPAG > IIPAG.OR.(LSTATS_ALLOC.AND.(IMEMC.NE.IIMEMC))) THEN + IF (LSTATS_ALLOC) IMEMC = GETCURHEAP() / 1024 + IF (IMEM > IIMEM .OR. IPAG > IIPAG .OR. (LSTATS_ALLOC .AND. (IMEMC .NE. IIMEMC))) THEN WRITE(0,'(A10,I5,1X,A20,1X,I6,2(1X,I7),1X,I6,1X,I4,1X,I4,1X,I7)') & - & "MEMORY aft ",KNUM,CCDESC(KNUM),IMEM-IIMEM,IMEM,IMEMH,IMEMS, & - & IPAG-IIPAG,NCALLS(KNUM)/2,IMEMC + & "MEMORY aft ", KNUM, CCDESC(KNUM), IMEM - IIMEM, IMEM, IMEMH, IMEMS, IPAG - IIPAG, & + & NCALLS(KNUM) / 2, IMEMC ENDIF - IIMEM=IMEM - IIPAG=IPAG - IIMEMC=IMEMC - IMEM=IMEM-NTMEM(KNUM,2) - NTMEM(KNUM,4)=NTMEM(KNUM,4)+IMEM - IF(IMEM > NTMEM(KNUM,1)) THEN - NTMEM(KNUM,1)=IMEM - NTMEM(KNUM,3)=NCALLS(KNUM) + IIMEM = IMEM + IIPAG = IPAG + IIMEMC = IMEMC + IMEM = IMEM - NTMEM(KNUM, 2) + NTMEM(KNUM,4) = NTMEM(KNUM, 4) + IMEM + IF (IMEM > NTMEM(KNUM,1)) THEN + NTMEM(KNUM,1) = IMEM + NTMEM(KNUM,3) = NCALLS(KNUM) ENDIF - IF(IMEM < NTMEM(KNUM,5)) NTMEM(KNUM,5)=IMEM + IF (IMEM < NTMEM(KNUM,5)) NTMEM(KNUM,5) = IMEM ENDIF -! Save counters that result in large delays - IF( KNUM >= 500 .AND. NCALLS(KNUM)/2 > 10 )THEN - IF( ZTIME > TIMESUM(KNUM)/FLOAT(NCALLS(KNUM)/2) + 0.2_JPRD )THEN - ! ignore counters 1007 and 1013 due to NFRLW frequency LW radiation calls + ! Save counters that result in large delays + IF (KNUM >= 500 .AND. NCALLS(KNUM) / 2 > 10)THEN + IF (ZTIME > TIMESUM(KNUM) / FLOAT(NCALLS(KNUM)/2) + 0.2_JPRD) THEN + ! Ignore counters 1007 and 1013 due to NFRLW frequency LW radiation calls ! in ec_phys_tl and ec_phys_ad call trees ! also ignore 635 and 636 due to increasing sujbwavallo matrix sizes - IF( KNUM /= 1007 .AND. KNUM /= 1013 .AND. KNUM /= 635 .AND. KNUM /= 636 )THEN - IF( NDELAY_INDEX < JPMAXDELAYS )THEN - NDELAY_INDEX=NDELAY_INDEX+1 - NDELAY_COUNTER(NDELAY_INDEX)=KNUM - TDELAY_VALUE(NDELAY_INDEX)=ZTIME-TIMESUM(KNUM)/FLOAT(NCALLS(KNUM)/2) - CALL DATE_AND_TIME(CLDATEOD,CDELAY_TIME(NDELAY_INDEX),CLZONEOD,IVALUES) + IF (KNUM /= 1007 .AND. KNUM /= 1013 .AND. KNUM /= 635 .AND. KNUM /= 636 ) THEN + IF (NDELAY_INDEX < JPMAXDELAYS) THEN + NDELAY_INDEX = NDELAY_INDEX + 1 + NDELAY_COUNTER(NDELAY_INDEX) = KNUM + TDELAY_VALUE(NDELAY_INDEX) = ZTIME - TIMESUM(KNUM) / FLOAT(NCALLS(KNUM) / 2) + CALL DATE_AND_TIME(CLDATEOD, CDELAY_TIME(NDELAY_INDEX), CLZONEOD, IVALUES) ENDIF ENDIF ENDIF ENDIF - ELSEIF( KSWITCH == 2 ) THEN -! Suspend timing event - ZTIMED = ZCLOCK-TIMELCALL(KNUM) - THISTIME(KNUM) = THISTIME(KNUM)+ZTIMED - THISTCPU(KNUM) = THISTCPU(KNUM)+ZTCPU-TTCPULCALL(KNUM) - THISVCPU(KNUM) = THISVCPU(KNUM)+ZVCPU-TVCPULCALL(KNUM) - IF(LSTATS_MPL.AND.CCTYPE(KNUM) .EQ. 'MPL') THEN - CALL MPL_STATSREAD(NSEND,SBYTES,NRECV,RBYTES) - NUMSEND(KNUM)=NUMSEND(KNUM)+NSEND - NUMRECV(KNUM)=NUMRECV(KNUM)+NRECV - SENDBYTES(KNUM)=SENDBYTES(KNUM)+SBYTES - RECVBYTES(KNUM)=RECVBYTES(KNUM)+RBYTES + ELSEIF (KSWITCH == 2) THEN + ! Suspend timing event + ZTIMED = ZCLOCK - TIMELCALL(KNUM) + THISTIME(KNUM) = THISTIME(KNUM) + ZTIMED + THISTCPU(KNUM) = THISTCPU(KNUM) + ZTCPU - TTCPULCALL(KNUM) + THISVCPU(KNUM) = THISVCPU(KNUM) + ZVCPU - TVCPULCALL(KNUM) + IF (LSTATS_MPL .AND. CCTYPE(KNUM) .EQ. 'MPL') THEN + CALL MPL_STATSREAD(NSEND, SBYTES, NRECV, RBYTES) + NUMSEND(KNUM) = NUMSEND(KNUM) + NSEND + NUMRECV(KNUM) = NUMRECV(KNUM) + NRECV + SENDBYTES(KNUM) = SENDBYTES(KNUM) + SBYTES + RECVBYTES(KNUM) = RECVBYTES(KNUM) + RBYTES ENDIF - ELSEIF( KSWITCH == 3 ) THEN -! Resume timing event + ELSEIF (KSWITCH == 3) THEN + ! Resume timing event TIMELCALL(KNUM) = ZCLOCK TTCPULCALL(KNUM) = ZTCPU TVCPULCALL(KNUM) = ZVCPU - IF(LSTATS_MPL.AND.CCTYPE(KNUM) .EQ. 'MPL') THEN - CALL MPL_STATSON(NSEND,SBYTES,NRECV,RBYTES) - UNKNOWN_NUMSEND(KNUM)=UNKNOWN_NUMSEND(KNUM)+NSEND - UNKNOWN_NUMRECV(KNUM)=UNKNOWN_NUMRECV(KNUM)+NRECV - UNKNOWN_SENDBYTES(KNUM)=UNKNOWN_SENDBYTES(KNUM)+SBYTES - UNKNOWN_RECVBYTES(KNUM)=UNKNOWN_RECVBYTES(KNUM)+RBYTES + IF (LSTATS_MPL .AND. CCTYPE(KNUM) .EQ. 'MPL') THEN + CALL MPL_STATSON(NSEND, SBYTES, NRECV, RBYTES) + UNKNOWN_NUMSEND(KNUM) = UNKNOWN_NUMSEND(KNUM) + NSEND + UNKNOWN_NUMRECV(KNUM) = UNKNOWN_NUMRECV(KNUM) + NRECV + UNKNOWN_SENDBYTES(KNUM) = UNKNOWN_SENDBYTES(KNUM) + SBYTES + UNKNOWN_RECVBYTES(KNUM) = UNKNOWN_RECVBYTES(KNUM) + RBYTES ENDIF - IF(KNUM>=500)THEN - ZTIMED = ZCLOCK-TIME_LAST_CALL - TIMESUMB(KNUM) = TIMESUMB(KNUM)+ZTIMED + IF (KNUM >= 500) THEN + ZTIMED = ZCLOCK - TIME_LAST_CALL + TIMESUMB(KNUM) = TIMESUMB(KNUM) + ZTIMED ENDIF ENDIF - IF(KNUM >= 500)THEN + IF (KNUM >= 500) THEN TIME_LAST_CALL = ZCLOCK ENDIF -! Trace stats - NCALLS_TOTAL = NCALLS_TOTAL+1 + ! Trace stats + NCALLS_TOTAL = NCALLS_TOTAL + 1 IF (LTRACE_STATS .AND. NCALLS_TOTAL <= NTRACE_STATS) THEN ICALL = NCALLS_TOTAL TIME_TRACE(ICALL) = ZCLOCK - NCALL_TRACE(ICALL) = (JPMAXSTAT+1)*KSWITCH+KNUM + NCALL_TRACE(ICALL) = (JPMAXSTAT+1) * KSWITCH + KNUM ENDIF -! measure gstats overhead + ! Measure gstats overhead CALL USER_CLOCK(PELAPSED_TIME=ZCLOCK1) - TIMESUM(400) = TIMESUM(400)+ZCLOCK1-ZCLOCK - NCALLS(400) = NCALLS(400)+1 - LAST_KSWITCH=KSWITCH - LAST_KNUM=KNUM - -! ZSUM=SUM(TIMESUM(500:JPMAXSTAT)) -! ZSUMB=SUM(TIMESUMB(500:JPMAXSTAT)) -! ZTOT=ZCLOCK1-TIMELCALL(0) -! IF( (ZSUM+ZSUMB)/ZTOT >1.0_JPRD )THEN -! write(0,'("GSTATS_DEBUG: KNUM=",I6," KSWITCH=",I1," (zsum+zsumb)/ztot=",F10.6)')& -! &KNUM,KSWITCH,(zsum+zsumb)/ztot -! ENDIF + TIMESUM(400) = TIMESUM(400) + ZCLOCK1 - ZCLOCK + NCALLS(400) = NCALLS(400) + 1 + LAST_KSWITCH = KSWITCH + LAST_KNUM = KNUM ENDIF -99999 CONTINUE END SUBROUTINE GSTATS diff --git a/src/fiat/gstats/gstats_barrier.F90 b/src/fiat/gstats/gstats_barrier.F90 index 723f8a9a..cacf5635 100644 --- a/src/fiat/gstats/gstats_barrier.F90 +++ b/src/fiat/gstats/gstats_barrier.F90 @@ -10,20 +10,18 @@ SUBROUTINE GSTATS_BARRIER(KNUM) -USE EC_PARKIND ,ONLY : JPIM - -USE YOMGSTATS, ONLY : LBARRIER_STATS -USE MPL_MODULE , ONLY : MPL_BARRIER +USE EC_PARKIND, ONLY: JPIM +USE YOMGSTATS, ONLY: LBARRIER_STATS +USE MPL_MODULE, ONLY: MPL_BARRIER IMPLICIT NONE INTEGER(KIND=JPIM) :: KNUM -IF(LBARRIER_STATS)THEN - CALL GSTATS(KNUM,0) +IF (LBARRIER_STATS) THEN + CALL GSTATS(KNUM, 0) CALL MPL_BARRIER() - CALL GSTATS(KNUM,1) + CALL GSTATS(KNUM, 1) ENDIF END SUBROUTINE GSTATS_BARRIER - diff --git a/src/fiat/gstats/gstats_barrier2.F90 b/src/fiat/gstats/gstats_barrier2.F90 index 38ac0e69..66a4f46a 100644 --- a/src/fiat/gstats/gstats_barrier2.F90 +++ b/src/fiat/gstats/gstats_barrier2.F90 @@ -10,27 +10,25 @@ SUBROUTINE GSTATS_BARRIER2(KNUM) -USE EC_PARKIND ,ONLY : JPIM - -USE YOMGSTATS, ONLY : LBARRIER_STATS2,NBAR_PTR,NBAR2 -USE MPL_MODULE , ONLY : MPL_BARRIER +USE EC_PARKIND, ONLY: JPIM +USE YOMGSTATS, ONLY: LBARRIER_STATS2, NBAR_PTR, NBAR2 +USE MPL_MODULE, ONLY: MPL_BARRIER IMPLICIT NONE INTEGER(KIND=JPIM) :: KNUM INTEGER(KIND=JPIM) :: INUM -IF(LBARRIER_STATS2)THEN - IF(NBAR_PTR(KNUM) == 0) THEN - INUM=NBAR2 - NBAR2=NBAR2+1 - NBAR_PTR(KNUM)=INUM +IF (LBARRIER_STATS2) THEN + IF (NBAR_PTR(KNUM) == 0) THEN + INUM = NBAR2 + NBAR2 = NBAR2 + 1 + NBAR_PTR(KNUM) = INUM ENDIF - INUM=NBAR_PTR(KNUM) - CALL GSTATS(INUM,0) + INUM = NBAR_PTR(KNUM) + CALL GSTATS(INUM, 0) CALL MPL_BARRIER() - CALL GSTATS(INUM,1) + CALL GSTATS(INUM, 1) ENDIF END SUBROUTINE GSTATS_BARRIER2 - diff --git a/src/fiat/gstats/gstats_label.F90 b/src/fiat/gstats/gstats_label.F90 index 2fdf1ad6..eb183b56 100644 --- a/src/fiat/gstats/gstats_label.F90 +++ b/src/fiat/gstats/gstats_label.F90 @@ -8,31 +8,29 @@ ! nor does it submit to any jurisdiction. ! -SUBROUTINE GSTATS_LABEL(KNUM,CTYPE,CDESC) +SUBROUTINE GSTATS_LABEL(KNUM, CTYPE, CDESC) -USE EC_PARKIND ,ONLY : JPIM - -USE YOMGSTATS +USE EC_PARKIND, ONLY: JPIM +USE YOMGSTATS, ONLY: JPMAXSTAT, CCDESC, CCTYPE, JPERR IMPLICIT NONE INTEGER(KIND=JPIM) :: KNUM -CHARACTER(*) CDESC -CHARACTER(*) CTYPE +CHARACTER(*) :: CDESC +CHARACTER(*) :: CTYPE INTEGER(KIND=JPIM) :: ILEN, ITLEN -IF(KNUM < 0 .OR. KNUM>JPMAXSTAT) CALL ABOR1('GSTATS_LABEL:ILLEGAL KNUM') +IF (KNUM < 0 .OR. KNUM > JPMAXSTAT) CALL ABOR1('GSTATS_LABEL:ILLEGAL KNUM') ILEN = LEN(CDESC) ILEN = MIN(ILEN,50) ITLEN = LEN(CTYPE) ITLEN = MIN(ILEN,3) -IF(CCDESC(KNUM) == '') THEN +IF (CCDESC(KNUM) == '') THEN CCDESC(KNUM) = CDESC(1:ILEN) CCTYPE(KNUM) = CTYPE(1:ITLEN) -ELSEIF(CCDESC(KNUM)(1:ILEN) /= CDESC(1:ILEN)) THEN - WRITE(JPERR,*)'LABEL',KNUM,' USED ',CCDESC(KNUM) +ELSEIF (CCDESC(KNUM)(1:ILEN) /= CDESC(1:ILEN)) THEN + WRITE(JPERR,*) 'LABEL', KNUM, ' USED ', CCDESC(KNUM) CALL ABOR1('GSTATS_LABEL:OVERWRITE OF USED LABEL') ENDIF END SUBROUTINE GSTATS_LABEL - diff --git a/src/fiat/gstats/gstats_print.F90 b/src/fiat/gstats/gstats_print.F90 index a8a08c98..91e7dbeb 100644 --- a/src/fiat/gstats/gstats_print.F90 +++ b/src/fiat/gstats/gstats_print.F90 @@ -55,11 +55,17 @@ SUBROUTINE GSTATS_PRINT(KULOUT,PAVEAVE,KLEN) ! F. Vana 05-Mar-2015 Support for single precision ! G. Mozdzynski 18-Aug-2015 Avoid confusion, procs are tasks ! ------------------------------------------------------------------ -USE EC_PARKIND ,ONLY : JPRD, JPIM -USE YOMGSTATS -USE MPL_MODULE -USE MPL_STATS_MOD +USE EC_PARKIND, ONLY: JPRD, JPIM +USE YOMGSTATS, ONLY: JPMAXDELAYS, JPMAXSTAT, NPROC_STATS, LXML_STATS, MYPROC_STATS, LSYNCSTATS, & + & LDETAILED_STATS, LSTATS_COMMS, LSTATS_OMP, LBARRIER_STATS2, JBMAXBASE, & + & NBAR_PTR, CCDESC, CCTYPE, LSTATS, TIMESUM, TIMESQSUM, TIMEMAX, TIMESUMB, & + & TIMELCALL, NCALLS, TTCPUSUM, TVCPUSUM, JPTAGSTAT, NPRCIDS_STATS, LSTATS_MPL, & + & NUMSEND, SENDBYTES, NUMRECV, RECVBYTES, LSTATSCPU, NPRNT_STATS, TIME_START, & + & UNKNOWN_NUMSEND, UNKNOWN_NUMRECV, UNKNOWN_SENDBYTES, UNKNOWN_RECVBYTES, & + & NDELAY_INDEX, NDELAY_COUNTER, TDELAY_VALUE, CDELAY_TIME, LTRACE_STATS, & + & NCALLS_TOTAL, NTRACE_STATS, NCALL_TRACE, TIME_TRACE, LSTATS_MEM, NTMEM +USE MPL_MODULE, ONLY: MPL_SEND, MPL_RECV, MPL_BARRIER IMPLICIT NONE @@ -110,8 +116,6 @@ SUBROUTINE GSTATS_PRINT(KULOUT,PAVEAVE,KLEN) ! ------------------------------------------------------------------ -! write(0,*) "JPMAXSTAT,NPRNT_STATS =",JPMAXSTAT,NPRNT_STATS - ILBUF = JPARRAYS*(JPMAXSTAT+1) ILRECV = 500*4 ZAVEAVE(:) = 0.0_JPRD @@ -305,7 +309,6 @@ SUBROUTINE GSTATS_PRINT(KULOUT,PAVEAVE,KLEN) ZT_SUMB=ZT_SUMB+ZSUMB ENDIF IF( LDETAILED_STATS .AND. JROC <= NPRNT_STATS ) THEN -! IF(JNUM < 501 .OR. LSTATS_COMMS .OR. LSTATS_OMP) THEN WRITE(KULOUT,'(I4,1X,A3,1X,A40,1X,I5,6(1X,F9.1),1X,F5.1,1X,F8.2)')& &JNUM,CCTYPE(JNUM),CCDESC(JNUM),ICALLS,ZSUM,ZAVE,ZAVETCPU,ZAVEVCPU,& &ZSTDDEV,ZMAX,ZSUMB,ZFRAC @@ -325,12 +328,9 @@ SUBROUTINE GSTATS_PRINT(KULOUT,PAVEAVE,KLEN) & '',ZFRAC,'',& & '' ENDIF -! ENDIF ENDIF ENDIF ENDDO -! ZCOMTIM = SUM(TIMESUM(51:99))+SUM(TIMESUM(151:199)) -! ZDETAIL = SUM(TIMESUM(:))-TIMESUM(0)-TIMESUM(1)-SUM(TIMESUM(20:23)) IF( LDETAILED_STATS .AND. JROC <= NPRNT_STATS ) THEN WRITE(KULOUT,*) '' WRITE(KULOUT,'((A,2F8.1))')& diff --git a/src/fiat/gstats/gstats_psut.F90 b/src/fiat/gstats/gstats_psut.F90 index 7b315541..bcb963e9 100644 --- a/src/fiat/gstats/gstats_psut.F90 +++ b/src/fiat/gstats/gstats_psut.F90 @@ -12,20 +12,18 @@ SUBROUTINE GSTATS_PSUT ! MEASURE PARALLELL START UP TIME -USE EC_PARKIND ,ONLY : JPRD, JPIM - -USE YOMGSTATS -USE MPL_MODULE - +USE EC_PARKIND, ONLY: JPRD, JPIM +USE YOMGSTATS, ONLY: NPROC_STATS, JPTAGSTAT, MYPROC_STATS, TIME_START, TIMELCALL, NPRCIDS_STATS +USE MPL_MODULE, ONLY: MPL_BARRIER, MPL_SEND, MPL_RECV IMPLICIT NONE -INTEGER(KIND=JPIM) :: ITAG,ILSEND,ILBUF,JROC,IRECV,ISEND -REAL(KIND=JPRD) :: ZTBUF(2),ZCLOCK,ZCLOCKB +INTEGER(KIND=JPIM) :: ITAG, ILSEND, ILBUF, JROC, IRECV, ISEND +REAL(KIND=JPRD) :: ZTBUF(2), ZCLOCK, ZCLOCKB #include "user_clock.intfb.h" -IF(NPROC_STATS > 1) THEN +IF (NPROC_STATS > 1) THEN CALL USER_CLOCK(PELAPSED_TIME=ZCLOCKB) CALL MPL_BARRIER CALL USER_CLOCK(PELAPSED_TIME=ZCLOCK) @@ -35,19 +33,17 @@ SUBROUTINE GSTATS_PSUT TIME_START(1) = ZCLOCKB - TIMELCALL(0) ILBUF = 2 ENDIF - DO JROC=2,NPROC_STATS + DO JROC = 2, NPROC_STATS IF (MYPROC_STATS .EQ. JROC ) THEN ZTBUF(1) = ZCLOCKB ZTBUF(2) = ZCLOCK ILSEND = 2 ISEND = 1 - CALL MPL_SEND(ZTBUF(1:ILSEND),KDEST=NPRCIDS_STATS(ISEND), & - & KTAG=ITAG,CDSTRING='SUSTATS:') + CALL MPL_SEND(ZTBUF(1:ILSEND), KDEST=NPRCIDS_STATS(ISEND), KTAG=ITAG, CDSTRING='SUSTATS:') ELSEIF (MYPROC_STATS == 1 ) THEN IRECV = JROC - CALL MPL_RECV(ZTBUF(1:ILBUF),KSOURCE=NPRCIDS_STATS(IRECV), & - & KTAG=ITAG,CDSTRING='SUSTATS:') - TIME_START(JROC) = ZTBUF(1) - TIMELCALL(0) -(ZTBUF(2)-ZCLOCK) + CALL MPL_RECV(ZTBUF(1:ILBUF), KSOURCE=NPRCIDS_STATS(IRECV), KTAG=ITAG, CDSTRING='SUSTATS:') + TIME_START(JROC) = ZTBUF(1) - TIMELCALL(0) - (ZTBUF(2) - ZCLOCK) ENDIF CALL MPL_BARRIER ENDDO diff --git a/src/fiat/gstats/gstats_query.F90 b/src/fiat/gstats/gstats_query.F90 new file mode 100644 index 00000000..d0e6b2c6 --- /dev/null +++ b/src/fiat/gstats/gstats_query.F90 @@ -0,0 +1,76 @@ +SUBROUTINE GSTATS_QUERY(KNUM,PTIME) + +!**** *GSTATS_QUERY* - Get current value of gstats timer + +! PURPOSE. +! -------- +! To query values of gstats timer for use in live output + + +!** INTERFACE. +! ---------- +! *CALL* *GSTATS(KNUM,PTIME) + +! EXPLICIT ARGUMENTS +! -------------------- +! KNUM - timing event number (for list of already defined events +! see routine STATS_OUTPUT) +! PTIME - Output current value of timer + +! IMPLICIT ARGUMENTS +! -------------------- +! Module YOMGSTATS + +! METHOD. +! ------- + +! REFERENCE. +! ---------- +! ECMWF Research Department documentation of the IFS + +! AUTHOR. +! ------- +! P. Gillies ECMWF + +! MODIFICATIONS. +! -------------- +! ORIGINAL : 2021-03-03 + +! ------------------------------------------------------------------ + +USE EC_PARKIND ,ONLY : JPRD, JPIM +USE YOMHOOK ,ONLY : LHOOK, DR_HOOK, JPHOOK + +USE YOMGSTATS +USE OML_MOD + +IMPLICIT NONE + +INTEGER(KIND=JPIM),INTENT(IN) :: KNUM +REAL(KIND=JPRD),INTENT(OUT) :: PTIME +REAL(KIND=JPHOOK) :: ZHOOK_HANDLE + +IF (LHOOK) CALL DR_HOOK('GSTATS_QUERY',0,ZHOOK_HANDLE) + +IF(LSTATS) THEN + +! only process gstats calls for master thread + + IF(OML_MY_THREAD() <= 1) THEN + + ! Return current total value of specified timer + IF(NCALLS(KNUM)>1) THEN + PTIME=TIMESUM(KNUM) + ELSE + PTIME=0.0_JPRD + ENDIF + + ENDIF + +ELSE + PTIME=0.0_JPRD +ENDIF + +IF (LHOOK) CALL DR_HOOK('GSTATS_QUERY',1,ZHOOK_HANDLE) + +END SUBROUTINE GSTATS_QUERY diff --git a/src/fiat/gstats/gstats_setup.F90 b/src/fiat/gstats/gstats_setup.F90 index 0b8a8291..e4a30add 100644 --- a/src/fiat/gstats/gstats_setup.F90 +++ b/src/fiat/gstats/gstats_setup.F90 @@ -54,10 +54,14 @@ SUBROUTINE GSTATS_SETUP( KPROC,KMYPROC,KPRCIDS,& ! rather than LBARRIER_STATS ! ------------------------------------------------------------------ -USE EC_PARKIND ,ONLY : JPIM ,JPRD - -USE YOMGSTATS -USE MPL_STATS_MOD +USE EC_PARKIND, ONLY: JPIM, JPRD +USE YOMGSTATS, ONLY: LSTATS, LSTATSCPU, LSYNCSTATS, LDETAILED_STATS, LBARRIER_STATS, & + & LBARRIER_STATS2, LXML_STATS, LSTATS_OMP, LSTATS_COMMS, NSTATS_MEM, & + & LSTATS_MEM, LSTATS_ALLOC, LTRACE_STATS, NTRACE_STATS, MYPROC_STATS, & + & NPROC_STATS, NPRCIDS_STATS, NCALL_TRACE, TIME_TRACE, LSTATS_MPL, NUMSEND, & + & NUMRECV, SENDBYTES, RECVBYTES, UNKNOWN_NUMSEND, UNKNOWN_NUMRECV, & + & UNKNOWN_SENDBYTES, UNKNOWN_RECVBYTES, NPRNT_STATS +USE MPL_STATS_MOD, ONLY: MPL_STATSINIT IMPLICIT NONE @@ -93,15 +97,15 @@ SUBROUTINE GSTATS_SETUP( KPROC,KMYPROC,KPRCIDS,& LSTATS_MEM = LDSTATS_MEM LSTATS_ALLOC = LDSTATS_ALLOC LTRACE_STATS = LDTRACE_STATS -IF(LTRACE_STATS) NTRACE_STATS = KTRACE_STATS +IF (LTRACE_STATS) NTRACE_STATS = KTRACE_STATS MYPROC_STATS = KMYPROC NPROC_STATS = KPROC ALLOCATE(NPRCIDS_STATS(NPROC_STATS)) NPRCIDS_STATS(:) = KPRCIDS(1:NPROC_STATS) -IF(NPROC_STATS == 1) LSYNCSTATS = .FALSE. +IF (NPROC_STATS == 1) LSYNCSTATS = .FALSE. -IF (LTRACE_STATS .AND. NTRACE_STATS>0 ) THEN +IF (LTRACE_STATS .AND. NTRACE_STATS > 0) THEN ALLOCATE(NCALL_TRACE(NTRACE_STATS)) ALLOCATE(TIME_TRACE (NTRACE_STATS)) NCALL_TRACE(:) = 0 @@ -109,8 +113,8 @@ SUBROUTINE GSTATS_SETUP( KPROC,KMYPROC,KPRCIDS,& ENDIF -IF(LDETAILED_STATS) THEN - LSTATS_MPL=.TRUE. +IF (LDETAILED_STATS) THEN + LSTATS_MPL = .TRUE. ALLOCATE(NUMSEND(501:1000)) ALLOCATE(NUMRECV(501:1000)) ALLOCATE(SENDBYTES(501:1000)) @@ -119,22 +123,17 @@ SUBROUTINE GSTATS_SETUP( KPROC,KMYPROC,KPRCIDS,& ALLOCATE(UNKNOWN_NUMRECV(501:1000)) ALLOCATE(UNKNOWN_SENDBYTES(501:1000)) ALLOCATE(UNKNOWN_RECVBYTES(501:1000)) - NUMSEND(:)=0 - NUMRECV(:)=0 - SENDBYTES(:)=0 - RECVBYTES(:)=0 - UNKNOWN_NUMSEND(:)=0 - UNKNOWN_NUMRECV(:)=0 - UNKNOWN_SENDBYTES(:)=0 - UNKNOWN_RECVBYTES(:)=0 + NUMSEND(:) = 0 + NUMRECV(:) = 0 + SENDBYTES(:) = 0 + RECVBYTES(:) = 0 + UNKNOWN_NUMSEND(:) = 0 + UNKNOWN_NUMRECV(:) = 0 + UNKNOWN_SENDBYTES(:) = 0 + UNKNOWN_RECVBYTES(:) = 0 CALL MPL_STATSINIT ENDIF -NPRNT_STATS=KPRNT_STATS - -! write(0,*) "GSTATS_SETUP: NPRNT_STATS=",NPRNT_STATS +NPRNT_STATS = KPRNT_STATS -RETURN END SUBROUTINE GSTATS_SETUP - - diff --git a/src/fiat/gstats/yomgstats.F90 b/src/fiat/gstats/yomgstats.F90 index 1c680b9e..508c9798 100644 --- a/src/fiat/gstats/yomgstats.F90 +++ b/src/fiat/gstats/yomgstats.F90 @@ -10,7 +10,7 @@ MODULE YOMGSTATS -USE EC_PARKIND ,ONLY : JPRD, JPIM +USE EC_PARKIND, ONLY: JPRD, JPIM IMPLICIT NONE diff --git a/src/fiat/include/fiat/mpl.h b/src/fiat/include/fiat/mpl.h index 181595c0..aeb08634 100644 --- a/src/fiat/include/fiat/mpl.h +++ b/src/fiat/include/fiat/mpl.h @@ -20,6 +20,8 @@ extern "C" { int mpl_init(); int mpl_end(); int mpl_myrank(); // Note return value is 1-based as opposed to MPI_Rank which is 0-based +int mpl_comm(); +int mpl_comm_oml(int oml_thread); // Note oml_thread argument is 1-based as opposed to omp_threads #ifdef __cplusplus } // extern "C" diff --git a/src/fiat/mpl/internal/mpl_allreduce_mod.F90 b/src/fiat/mpl/internal/mpl_allreduce_mod.F90 index ab335786..03864a1a 100644 --- a/src/fiat/mpl/internal/mpl_allreduce_mod.F90 +++ b/src/fiat/mpl/internal/mpl_allreduce_mod.F90 @@ -210,8 +210,8 @@ SUBROUTINE MPL_ALLREDUCE_INT(KSENDBUF,CDOPER,LDREPROD, & ISENDCOUNT = SIZE(KSENDBUF) -IF (ISENDCOUNT > 0) THEN #ifndef NAG +IF (ISENDCOUNT > 0) THEN IF( (LOC(KSENDBUF(UBOUND(KSENDBUF,1)))-LOC(KSENDBUF(LBOUND(KSENDBUF,1)))) /= 4_JPIB*(ISENDCOUNT - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_ALLREDUCE: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF diff --git a/src/fiat/mpl/internal/mpl_broadcast_mod.F90 b/src/fiat/mpl/internal/mpl_broadcast_mod.F90 index 403374d3..4bf54ead 100644 --- a/src/fiat/mpl/internal/mpl_broadcast_mod.F90 +++ b/src/fiat/mpl/internal/mpl_broadcast_mod.F90 @@ -291,12 +291,14 @@ SUBROUTINE MPL_BROADCAST_REAL42(PBUF,KTAG,KROOT,KMP_TYPE,KCOMM,KERROR,KREQUEST,C IERROR = 0 ICOUNT = SIZE(PBUF) +#ifndef NAG IF (ICOUNT > 0) THEN IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2))) - & & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2)))) /= 4_JPIB*(ICOUNT - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN CALL MPI_BCAST(PBUF(1,1),ICOUNT,INT(MPI_REAL4),IROOT-1,ICOMM,IERROR) @@ -344,12 +346,14 @@ SUBROUTINE MPL_BROADCAST_REAL43(PBUF,KTAG,KROOT,KMP_TYPE,KCOMM,KERROR,KREQUEST,C IERROR = 0 ICOUNT = SIZE(PBUF) +#ifndef NAG IF (ICOUNT > 0) THEN IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3))) - & & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3)))) /= 4_JPIB*(ICOUNT - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN CALL MPI_BCAST(PBUF(1,1,1),ICOUNT,INT(MPI_REAL4),IROOT-1,ICOMM,IERROR) @@ -397,6 +401,7 @@ SUBROUTINE MPL_BROADCAST_REAL44(PBUF,KTAG,KROOT,KMP_TYPE,KCOMM,KERROR,KREQUEST,C IERROR = 0 ICOUNT = SIZE(PBUF) +#ifndef NAG IF (ICOUNT > 0) THEN IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3),UBOUND(PBUF,4))) - & & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3),LBOUND(PBUF,4)))) & @@ -404,6 +409,7 @@ SUBROUTINE MPL_BROADCAST_REAL44(PBUF,KTAG,KROOT,KMP_TYPE,KCOMM,KERROR,KREQUEST,C CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN CALL MPI_BCAST(PBUF(1,1,1,1),ICOUNT,INT(MPI_REAL4),IROOT-1,ICOMM,IERROR) @@ -791,12 +797,14 @@ SUBROUTINE MPL_BROADCAST_INT2(KBUF,KTAG,KROOT,KMP_TYPE,& IERROR = 0 ICOUNT = SIZE(KBUF) +#ifndef NAG IF (ICOUNT > 0) THEN IF( (LOC(KBUF(UBOUND(KBUF,1),UBOUND(KBUF,2))) - & & LOC(KBUF(LBOUND(KBUF,1),LBOUND(KBUF,2)))) /= 4_JPIB*(ICOUNT - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN CALL MPI_BCAST(KBUF(1,1),ICOUNT,INT(MPI_INTEGER),IROOT-1,ICOMM,IERROR) @@ -846,12 +854,14 @@ SUBROUTINE MPL_BROADCAST_INT3(KBUF,KTAG,KROOT,KMP_TYPE,& IERROR = 0 ICOUNT = SIZE(KBUF) +#ifndef NAG IF (ICOUNT > 0) THEN IF( (LOC(KBUF(UBOUND(KBUF,1),UBOUND(KBUF,2),UBOUND(KBUF,3))) - & & LOC(KBUF(LBOUND(KBUF,1),LBOUND(KBUF,2),LBOUND(KBUF,3)))) /= 4_JPIB*(ICOUNT - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_BROADCAST: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD .OR. IMP_TYPE == JP_BLOCKING_BUFFERED) THEN CALL MPI_BCAST(KBUF(1,1,1),ICOUNT,INT(MPI_INTEGER),IROOT-1,ICOMM,IERROR) diff --git a/src/fiat/mpl/internal/mpl_comm_compare_mod.F90 b/src/fiat/mpl/internal/mpl_comm_compare_mod.F90 new file mode 100644 index 00000000..a31162e6 --- /dev/null +++ b/src/fiat/mpl/internal/mpl_comm_compare_mod.F90 @@ -0,0 +1,50 @@ +! (C) Copyright 2023- ECMWF. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. +! + +MODULE MPL_COMM_COMPARE_MOD + +!**** *MPL_COMM_COMPARE_MOD* - Compare two communicators + +! Author. +! ------- +! Willem Deconinck *ECMWF* +! Original : 31-08-2023 + +USE EC_PARKIND, ONLY : JPIM + +IMPLICIT NONE + +PRIVATE +PUBLIC :: MPL_COMM_COMPARE + +CONTAINS + +SUBROUTINE MPL_COMM_COMPARE (KCOMM1, KCOMM2, KRES, KERR, CDSTRING) +USE MPL_MPIF + +INTEGER (KIND=JPIM), INTENT (IN) :: KCOMM1 +INTEGER (KIND=JPIM), INTENT (IN) :: KCOMM2 +INTEGER (KIND=JPIM), INTENT (OUT) :: KRES +INTEGER (KIND=JPIM), INTENT (OUT) :: KERR +CHARACTER (LEN=*), INTENT (IN), OPTIONAL :: CDSTRING + +CALL MPI_COMM_COMPARE (KCOMM1, KCOMM2, KRES, KERR) +if( KRES == MPI_IDENT ) THEN + KRES = 0 ! contexts and groups are the same +ELSEIF (KRES == MPI_CONGRUENT) THEN + KRES = 1 ! different contexts but identical groups +ELSEIF (KRES == MPI_SIMILAR) THEN + KRES = 2 ! different contexts but similar groups +ELSE ! (KRES == MPI_UNEQUAL) THEN + KRES = 3 ! otherwise +ENDIF + +END SUBROUTINE MPL_COMM_COMPARE + +END MODULE MPL_COMM_COMPARE_MOD diff --git a/src/fiat/mpl/internal/mpl_gatherv_mod.F90 b/src/fiat/mpl/internal/mpl_gatherv_mod.F90 index c26bc91f..d78e7e21 100644 --- a/src/fiat/mpl/internal/mpl_gatherv_mod.F90 +++ b/src/fiat/mpl/internal/mpl_gatherv_mod.F90 @@ -91,8 +91,8 @@ MODULE MPL_GATHERV_MOD INTEGER(KIND=JPIM) :: ZDUM_INT INTERFACE MPL_GATHERV -MODULE PROCEDURE MPL_GATHERV_REAL8,MPL_GATHERV_REAL4,MPL_GATHERV_INT,& - & MPL_GATHERV_INT_SCALAR,MPL_GATHERV_CHAR_SCALAR +MODULE PROCEDURE MPL_GATHERV_REAL8,MPL_GATHERV_REAL4,MPL_GATHERV_CHAR_SCALAR,& + & MPL_GATHERV_INT,MPL_GATHERV_INT_SCALAR END INTERFACE PUBLIC MPL_GATHERV @@ -109,7 +109,6 @@ SUBROUTINE MPL_GATHERV_PREAMB1(IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYP #endif - INTEGER(KIND=JPIM),INTENT(OUT) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOMM,KMP_TYPE,KREQUEST @@ -373,14 +372,13 @@ SUBROUTINE MPL_GATHERV_CHAR_SCALAR(CSENDBUF,KROOT,CRECVBUF,KRECVCOUNTS,KSENDCOUN #endif -!CHARACTER*(*) :: CDBUF -CHARACTER*(*) :: CSENDBUF -INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVCOUNTS(:),KSENDCOUNT -INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT -CHARACTER*(*),OPTIONAL :: CRECVBUF(:) -INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE +CHARACTER(LEN=*) :: CSENDBUF +INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVCOUNTS(:),KSENDCOUNT +INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KROOT +CHARACTER(LEN=*),OPTIONAL :: CRECVBUF(:) +INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KRECVDISPL(:),KCOMM,KMP_TYPE INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KREQUEST -CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING +CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: CDSTRING INTEGER(KIND=JPIM) :: IRECVDISPL(MPL_NUMPROC) INTEGER(KIND=JPIM) :: IERROR,IPL_NUMPROC,IPL_MYRANK,ICOMM,IROOT,IMP_TYPE diff --git a/src/fiat/mpl/internal/mpl_init_mod.F90 b/src/fiat/mpl/internal/mpl_init_mod.F90 index 54924d42..32782f96 100644 --- a/src/fiat/mpl/internal/mpl_init_mod.F90 +++ b/src/fiat/mpl/internal/mpl_init_mod.F90 @@ -332,7 +332,7 @@ SUBROUTINE MPL_INIT(KOUTPUT,KUNIT,KERROR,KPROCS,LDINFO,LDENV) MPL_NCPU_PER_NODE=32 ELSE MPL_NCPU_PER_NODE=1 - IF(LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_NCPU_PER_NODE = 1 (CAUTION: could not be inferred from hostname!)' + !IF(LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_NCPU_PER_NODE = 1 (CAUTION: could not be inferred from hostname!)' ENDIF ELSE READ(CL_TASKSPERNODE,*) MPL_NCPU_PER_NODE diff --git a/src/fiat/mpl/internal/mpl_recv_mod.F90 b/src/fiat/mpl/internal/mpl_recv_mod.F90 index 68dad232..a127c43b 100644 --- a/src/fiat/mpl/internal/mpl_recv_mod.F90 +++ b/src/fiat/mpl/internal/mpl_recv_mod.F90 @@ -744,12 +744,14 @@ SUBROUTINE MPL_RECV_REAL43(PBUF,KSOURCE,KTAG,KCOMM,KFROM,KRECVTAG,& IBUFFSIZE = SIZE(PBUF) +#ifndef NAG IF (IBUFFSIZE > 0) THEN IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3))) - & & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3)))) /= 4_JPIB*(IBUFFSIZE - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_RECV: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD) THEN CALL MPI_RECV(PBUF,IBUFFSIZE,INT(MPI_REAL4),ISOURCE,ITAG,ICOMM,IRECV_STATUS,IERROR) @@ -862,12 +864,14 @@ SUBROUTINE MPL_RECV_REAL83(PBUF,KSOURCE,KTAG,KCOMM,KFROM,KRECVTAG,& IBUFFSIZE = SIZE(PBUF) +#ifndef NAG IF (IBUFFSIZE > 0) THEN IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3))) - & & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3)))) /= 8_JPIB*(IBUFFSIZE - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_RECV: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD) THEN CALL MPI_RECV(PBUF,IBUFFSIZE,INT(MPI_REAL8),ISOURCE,ITAG,ICOMM,IRECV_STATUS,IERROR) diff --git a/src/fiat/mpl/internal/mpl_send_mod.F90 b/src/fiat/mpl/internal/mpl_send_mod.F90 index 7e5d8f5f..7419fbd4 100644 --- a/src/fiat/mpl/internal/mpl_send_mod.F90 +++ b/src/fiat/mpl/internal/mpl_send_mod.F90 @@ -826,12 +826,14 @@ SUBROUTINE MPL_SEND_REAL43(PBUF,KDEST,KTAG,KCOMM,KMP_TYPE,KERROR,KREQUEST,CDSTRI CALL MPL_SENDSTATS(ICOUNT,INT(MPI_REAL4)) ENDIF +#ifndef NAG IF (ICOUNT > 0) THEN IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3))) - & & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3)))) /= 4_JPIB*(ICOUNT - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_SEND: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD) THEN CALL MPI_SEND(PBUF,ICOUNT,INT(MPI_REAL4),KDEST-1,KTAG,ICOMM,IERROR) @@ -1302,12 +1304,14 @@ SUBROUTINE MPL_SEND_REAL83(PBUF,KDEST,KTAG,KCOMM,KMP_TYPE,KERROR,KREQUEST,CDSTRI CALL MPL_SENDSTATS(ICOUNT,INT(MPI_REAL8)) ENDIF +#ifndef NAG IF (ICOUNT > 0) THEN IF( (LOC(PBUF(UBOUND(PBUF,1),UBOUND(PBUF,2),UBOUND(PBUF,3))) - & & LOC(PBUF(LBOUND(PBUF,1),LBOUND(PBUF,2),LBOUND(PBUF,3)))) /= 8_JPIB*(ICOUNT - 1) ) THEN CALL MPL_MESSAGE(CDMESSAGE='MPL_SEND: BUFFER NOT CONTIGUOUS ',LDABORT=LLABORT) ENDIF ENDIF +#endif IF(IMP_TYPE == JP_BLOCKING_STANDARD) THEN CALL MPI_SEND(PBUF,ICOUNT,INT(MPI_REAL8),KDEST-1,KTAG,ICOMM,IERROR) diff --git a/src/fiat/mpl/mpl_bindc.F90 b/src/fiat/mpl/mpl_bindc.F90 index 5079a109..7f773696 100644 --- a/src/fiat/mpl/mpl_bindc.F90 +++ b/src/fiat/mpl/mpl_bindc.F90 @@ -56,6 +56,23 @@ FUNCTION MPL_MYRANK_BINDC() BIND(C,NAME="mpl_myrank") RESULT(MYRANK) MYRANK = MPL_MYRANK() END FUNCTION +FUNCTION MPL_COMM_BINDC() BIND(C,NAME="mpl_comm") RESULT(NCOMM) + USE ISO_C_BINDING, ONLY : C_INT + USE MPL_MODULE, ONLY : MPL_COMM + IMPLICIT NONE + INTEGER(KIND=C_INT) :: NCOMM + NCOMM = MPL_COMM +END FUNCTION + +FUNCTION MPL_COMM_OML_BINDC(OML_THREAD) BIND(C,NAME="mpl_comm_oml") RESULT(NCOMM) + USE ISO_C_BINDING, ONLY : C_INT + USE MPL_MODULE, ONLY : MPL_COMM_OML + IMPLICIT NONE + INTEGER(KIND=C_INT) :: NCOMM + INTEGER(KIND=C_INT), VALUE, INTENT(IN) :: OML_THREAD + NCOMM = MPL_COMM_OML(OML_THREAD) +END FUNCTION + ! SUBROUTINE CMPL_ABORT(CDMESS) ! USE MPL_MODULE diff --git a/src/fiat/mpl/mpl_module.F90 b/src/fiat/mpl/mpl_module.F90 index 96b36c30..98615407 100644 --- a/src/fiat/mpl/mpl_module.F90 +++ b/src/fiat/mpl/mpl_module.F90 @@ -34,6 +34,7 @@ MODULE MPL_MODULE USE MPL_END_MOD USE MPL_MESSAGE_MOD USE MPL_ABORT_MOD +USE MPL_COMM_COMPARE_MOD USE MPL_COMM_CREATE_MOD USE MPL_COMM_FREE_MOD USE MPL_COMM_SPLIT_MOD diff --git a/src/fiat/system/gethwm.c b/src/fiat/system/gethwm.c index e879fa40..3e4456d4 100644 --- a/src/fiat/system/gethwm.c +++ b/src/fiat/system/gethwm.c @@ -50,7 +50,7 @@ ll_t gethwm() #else ll_t gethwm() { - ll_t rc = (ll_t)((char *)sbrk(0) - (char *)0); + ll_t rc = (ll_t)((uintptr_t)sbrk(0)); return rc; } #endif diff --git a/src/fiat/system/internal/linux_bind.c b/src/fiat/system/internal/linux_bind.c index 05b8d70d..977c6093 100644 --- a/src/fiat/system/internal/linux_bind.c +++ b/src/fiat/system/internal/linux_bind.c @@ -1,9 +1,10 @@ /* * (C) Copyright 2005- ECMWF. * (C) Copyright 2005- Meteo France. - * + * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. + * * In applying this licence, ECMWF does not waive the privileges and immunities * granted to it by virtue of its status as an intergovernmental organisation * nor does it submit to any jurisdiction. diff --git a/src/fiat/system/internal/linuxtrbk.c b/src/fiat/system/internal/linuxtrbk.c index 182cf98c..0fddff0a 100644 --- a/src/fiat/system/internal/linuxtrbk.c +++ b/src/fiat/system/internal/linuxtrbk.c @@ -1,6 +1,6 @@ /* - * (C) Copyright 2005- ECMWF. - * + * (C) Copyright 2006- ECMWF. + * * This software is licensed under the terms of the Apache Licence Version 2.0 * which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. * In applying this licence, ECMWF does not waive the privileges and immunities diff --git a/src/fiat/util/getopt.F90 b/src/fiat/util/getopt.F90 index 60b3b840..059854d4 100644 --- a/src/fiat/util/getopt.F90 +++ b/src/fiat/util/getopt.F90 @@ -11,6 +11,9 @@ FUNCTION GETOPT(Y_OPTSTR, Y_OPTARG) USE EC_PARKIND, ONLY : JPIM +#ifdef NAG +use F90_UNIX, only: GETARG +#endif IMPLICIT NONE INTEGER(KIND=JPIM) :: GETOPT diff --git a/src/mpi_serial/CMakeLists.txt b/src/mpi_serial/CMakeLists.txt index 82768ac6..19872e28 100644 --- a/src/mpi_serial/CMakeLists.txt +++ b/src/mpi_serial/CMakeLists.txt @@ -24,6 +24,7 @@ ecbuild_add_library( TARGET mpi_serial mpi_cart_create.F mpi_cart_rank.F mpi_cart_sub.F + mpi_comm_compare.F mpi_comm_create.F mpi_comm_free.F mpi_comm_group.F diff --git a/src/mpi_serial/mpi_comm_compare.F b/src/mpi_serial/mpi_comm_compare.F new file mode 100644 index 00000000..5a322620 --- /dev/null +++ b/src/mpi_serial/mpi_comm_compare.F @@ -0,0 +1,15 @@ +C (C) Copyright 2023- ECMWF. +C +C This software is licensed under the terms of the Apache Licence Version 2.0 +C which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +C In applying this licence, ECMWF does not waive the privileges and immunities +C granted to it by virtue of its status as an intergovernmental organisation +C nor does it submit to any jurisdiction. +C + + subroutine mpi_comm_compare(KCOMM1,KCOMM2,IRESULT,IERR) + iresult=0 + ierr=0 +! call abor1('mpi_comm_compare should never be called') + return + end diff --git a/src/parkind/CMakeLists.txt b/src/parkind/CMakeLists.txt index 0e1855e8..882de4e3 100644 --- a/src/parkind/CMakeLists.txt +++ b/src/parkind/CMakeLists.txt @@ -11,30 +11,25 @@ set( HAVE_sp ${HAVE_SINGLE_PRECISION} ) foreach( prec sp dp ) if( HAVE_${prec} ) - - ecbuild_add_library( - TARGET parkind_${prec} - SOURCES parkind1.F90 - parkind2.F90 - ) - - fiat_target_fortran_module_directory( - TARGET parkind_${prec} - MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/module/parkind_${prec} - INSTALL_DIRECTORY module/parkind_${prec} - ) - - if( ${prec} MATCHES "sp" ) + set( target parkind_${prec} ) + ecbuild_add_library( + TARGET ${target} + SOURCES parkind1.F90 + parkind2.F90 + ) if( EC_OS_BITS EQUAL "64" ) - target_compile_definitions( parkind_${prec} PRIVATE ADDRESS64 ) + target_compile_definitions( ${target} PRIVATE ADDRESS64 ) endif() - target_compile_definitions( parkind_${prec} PRIVATE PARKIND1_SINGLE ) - - endif() - + fiat_target_fortran_module_directory( + TARGET ${target} + MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/module/${target} + INSTALL_DIRECTORY module/${target} + ) endif() endforeach() - +if( TARGET parkind_sp ) + target_compile_definitions( parkind_sp PRIVATE PARKIND1_SINGLE ) +endif() diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 6b8a70f2..22c73c98 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -54,6 +54,7 @@ ecbuild_add_executable( TARGET fiat-test-drhook-no-output SOURCES test_drhook_no_output.c LIBS fiat + LINKER_LANGUAGE C NOINSTALL ) add_test( NAME fiat_test_drhook_no_output COMMAND ${CMAKE_COMMAND} @@ -74,6 +75,7 @@ ecbuild_add_executable( TARGET fiat-test-drhook-abort SOURCES test_drhook_abort.c LIBS fiat + LINKER_LANGUAGE C NOINSTALL ) @@ -169,6 +171,12 @@ foreach( lang C CXX Fortran ) if( CMAKE_${lang}_COMPILER ) list( APPEND _test_args "-DCMAKE_${lang}_COMPILER=${CMAKE_${lang}_COMPILER}" ) endif() + if( CMAKE_${lang}_FLAGS ) + list( APPEND _test_args "-DCMAKE_${lang}_FLAGS=${CMAKE_${lang}_FLAGS}" ) + endif() + if( CMAKE_EXE_LINKER_FLAGS ) + list( APPEND _test_args "-DCMAKE_EXE_LINKER_FLAGS=${CMAKE_EXE_LINKER_FLAGS}" ) + endif() endforeach() add_test( NAME fiat_test_install diff --git a/tests/drhook/CMakeLists.txt b/tests/drhook/CMakeLists.txt index 37c1c1d7..86abe6fd 100644 --- a/tests/drhook/CMakeLists.txt +++ b/tests/drhook/CMakeLists.txt @@ -21,6 +21,7 @@ ecbuild_add_executable( TARGET drhook_ex3 ecbuild_add_executable( TARGET drhook_ex4 SOURCES drhook_ex4.c LIBS fiat ${CMATH_LIBRARIES} + LINKER_LANGUAGE C NOINSTALL ) ecbuild_add_executable( TARGET drhook_ex5 diff --git a/tests/drhook/drhook_ex1.F90 b/tests/drhook/drhook_ex1.F90 index 8335e202..d3c481f5 100644 --- a/tests/drhook/drhook_ex1.F90 +++ b/tests/drhook/drhook_ex1.F90 @@ -2,6 +2,7 @@ ! ! This software is licensed under the terms of the Apache Licence Version 2.0 ! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! ! In applying this licence, ECMWF does not waive the privileges and immunities ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction.