123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960 |
- program lucia_analysis
- !
- ! ===================================
- ! LUCIA post-processing analysis tool
- ! ===================================
- !
- ! Purpose:
- ! - Load balance an OASIS-based coupled system
- ! - Assess scalabilities of each model of the coupled system
- ! - Estimate coupling cost (interpolations) and models jitter
- !
- ! Getting started:
- !
- ! - compile your model with OASIS version newer than
- ! - launch coupled sytem with second LOGPRT parameter equal
- ! to -1 (in namcouple file)
- ! - process lucia.??.?????? files with lucia-mct script
- ! shell provided with the present FORTRAN program
- !
- implicit none
- !
- ! Information related to each coupled field
- !
- type FIELD_SEQUENCE
- integer*4 :: namID ! field rank in namcouple
- integer*4 :: source_model ! index of source model
- integer*4 :: target_model ! index of target model
- integer*4 :: source_comm_nb ! number of send actions from source
- integer*4 :: target_comm_nb ! number of receive actions from target
- end type FIELD_SEQUENCE
- ! Explicit logical flags
- logical :: l_put, l_before, l_exch_still_valid, l_exch_not_yet_valid, l_add_interp_time
- !
- character(len=20) :: c_verif ! Lucia identifyer (no more used)
- character(len=3) :: c_field_code ! code for field number or info provided during init
- character(len=24) :: c_field_name
- character(len=15) :: c_comm_type ! kind of exchange (put or get)
- ! Parameters
- character(len=3) :: c_ident_put = "put"
- character(len=3) :: c_ident_before = "Before"
- ! Buffer arrays
- character(len=3) :: c_test_name
- character(len=24) :: c_dummy
- character(len=300) :: c_argument, log_file_name
- !
- character(len=20), dimension(:,:), allocatable :: field_name
- character(len=10), dimension(:), allocatable :: model_name
- character(len=10), dimension(:), allocatable :: model_code ! model rank on OASIS sequence
- !
- ! for first static allocation, maximum number of coupling fields
- integer*4 :: max_nb_fields = 300
- !
- ! Indexes or temporary arrays
- integer*4 :: i, j, k, l, mi, narg, i_err, newf, tmp_field_code
- integer*4 :: nb_models
- integer*4 :: nb_tot_log_files, log_nb ! number of log file processed and index
- integer*4 :: cpl_field_nb ! total number of coupling fields
- ! same as NFIELDS parameter in namcouple
- integer*4 :: i_cpl ! coupling field index (namcouple order)
- integer*4 :: clk_i ! event index 1: before send
- ! 2: after send
- ! 3: before receive
- ! 4: after receive
- integer*4 :: before_send = 1
- integer*4 :: after_send = 2
- integer*4 :: before_recv = 3
- integer*4 :: after_recv = 4
- integer*4 :: after_send_or_recv = 2
- integer*4 :: max_comm_nb ! maximum nb of coupling tstep among coupling fields
- integer*4 :: i_first_exchg(2) ! indexes of first coupling field exchanged
- integer*4, dimension(:), allocatable :: nb_mpi ! array of mpi partition nb per model
- integer*4, dimension(:), allocatable :: i_stride ! stride for log file counting per model
- integer*4, dimension(:), allocatable :: i_file_count ! log file nb per model
- integer*4, dimension(:), allocatable :: valid_comm_nb ! nb of valid coupling tstep per model
- integer*4, dimension(:), allocatable :: first_valid_comm ! index of first valid communication
- integer*4, dimension(:), allocatable :: i_cpl_field ! index of coupling field in exchange sequence
- integer*4, dimension(:,:), allocatable :: field_code ! index of coupling fields in namcouple exchange
- integer*4, dimension(:,:), allocatable :: comm_type ! Communication type
- ! 0: get
- ! 1: put
- integer*4, dimension(:,:), allocatable :: comm_nb ! nb of coupling tstep per model and per field
- !
- real*8 :: r_clock ! read clock time
- real*8 :: r_min_time, r_max_time ! time boundaries
- real*8 :: r_reference = -1.E8 ! reference time
- real*8 :: r_mean ! tmp buffer
- real*8 :: temp_t ! tmp buffer
- real*8 :: r_impossible_value= 1.E13 ! reference time
- real*8 :: r_test_impossible= 1.E12 ! reference time
- real*8, dimension(:), allocatable :: calc_time, noncalc_time ! calculation and non calculation time per model
- ! Timing for interpolation time and jitter per model
- real*8, dimension(:), allocatable :: r_interp_measure, r_interp_time, r_jitter_time
- ! Evaluation of variance among log files
- real*8, dimension(:), allocatable :: send_spread, receive_spread, calc_spread
- real*8, dimension(:,:), allocatable :: start_time ! beginning of first coupling sequence
- real*8, dimension(:,:,:), allocatable :: min_clock_measure ! measure of min among log files
- real*8, dimension(:,:,:), allocatable :: max_clock_measure ! measure of max among log files
- real*8, dimension(:,:,:), allocatable :: calc_noncalc_measure ! calculation and non calculation time for each event
- !
- ! Informations on coupling fields
- type(FIELD_SEQUENCE), dimension(:), allocatable :: cpl_fields
- !
- ! external function
- integer*4 :: iargc
- !
- !
- ! GET THE NUMBER OF COMMAND LINE ARGUMENTS.
- !
- narg = iargc()
- !
- ! CHECK THE NUMBER OF COMMAND LINE ARGUMENTS.
- !
- if ( narg==0 ) then
- write (6,*)
- write (6,*) ' Error: Missing arguments'
- stop
- else if ( narg<6 ) then
- write (6,*) ' Wrong number of line arguments '
- write (6,*) ' Coupled models should be 2 at least '
- stop
- end if
- !
- ! 3 argument per model
- nb_models = narg / 3
- !
- ! ALLOCATIONS of nb_models dimensional arrays
- allocate(nb_mpi(nb_models))
- allocate(i_stride(nb_models))
- allocate(i_file_count(nb_models))
- allocate(i_cpl_field(nb_models))
- allocate(model_name(nb_models))
- allocate(model_code(nb_models))
- allocate(calc_time(nb_models))
- allocate(noncalc_time(nb_models))
- allocate(r_jitter_time(nb_models))
- allocate(send_spread(nb_models))
- allocate(receive_spread(nb_models))
- allocate(calc_spread(nb_models))
- allocate(r_interp_time(nb_models))
- allocate(valid_comm_nb(nb_models))
- allocate(first_valid_comm(nb_models))
- ! ALLOCATIONS of nb_models x max_nb_fields dimensional arrays
- allocate(field_name(nb_models, max_nb_fields))
- allocate(field_code(nb_models, max_nb_fields))
- allocate(comm_type(nb_models, max_nb_fields))
- allocate(comm_nb(nb_models, max_nb_fields))
- allocate(start_time(nb_models, max_nb_fields))
- comm_nb(:,:) = 0
- start_time(:,:) = r_impossible_value
- !
- ! DEFAULT VALUES FOR COMMAND LINE ARGUMENTS.
- !
- nb_mpi(:) = 1
- model_code(:) = "none"
- model_name(:) = "none"
- field_name(:,:) = "none"
- !
- ! 1. CHECK THE COMMAND LINE ARGUMENTS.
- !
- do i = 1, nb_models
- !
- ! GET MODEL RANK ON OASIS SEQUENCE
- call getarg( 3*i-2, model_code(i) )
- !
- ! GET LOG FILE NB
- call getarg( 3*i-1, c_argument )
- read(c_argument,'(i6)') i_stride(i)
- ! must be greater than 1
- i_stride(i) = MAX(i_stride(i),1)
- !
- ! GET NUMBER OF MPI SUBDOMAINS
- call getarg( 3*i, c_argument )
- read(c_argument,'(i6)') nb_mpi(i)
- ! check that stride still greater than 1
- i_stride(i) = MAX ( nb_mpi(i) / MAX((i_stride(i)-1),1), 1)
- !
- end do
- !
- ! 2. READ OASIS-LUCIA LOG FILES CONTAINT
- !
- ! DATA ARE READ FOR A FIRST TIME TO FIND ARRAYs LENGTH
- ! AND COUPLING FIELDS EXCHANGE SEQUENCE
- !
- write(6,*) ' '
- write(6,*) ' Processing OASIS LUCIA log files! '
- write(6,*) ' '
- !
- i_cpl_field(:)=0
- ! Loop on model number
- do i = 1, nb_models
- !
- i_file_count(i) = 0
- k = 1
- write(6,*) 'Computed log files for model ', model_code(i), nb_mpi(i), i_stride(i)
- call flush(6)
- ! Loop on log file number
- do j = 0, nb_mpi(i), i_stride(i)
- ! Count number of log file per model
- i_file_count(i) = i_file_count(i) + 1
- write(log_file_name,'("lucia.",a2,".",i6.6)'),model_code(i),j
- write(6,'(TL16,A,1X)', advance='no') TRIM(log_file_name)
- call flush(6)
- OPEN (unit=10, &
- file=TRIM(log_file_name), &
- action="read", &
- status="OLD", &
- form="formatted", &
- iostat=i_err)
- if ( i_err .ne. 0 ) then
- write(6,*) 'Error opening ASCII file ', TRIM(log_file_name)
- stop
- end if
- ! write (6,*) ' open ', log_file_name
- !
- !
- ! FIRST GUESS: GET FIELD NAMES AND EXCHANGE TYPE
- !
- REWIND(10)
- i_err=0
- ! For each line of the log file
- DO WHILE ( i_err /= -1 )
- READ(10, '(A9,A3,A12,A4,F16.5)', iostat=i_err) &
- & c_verif, &
- & c_field_code, &
- & c_dummy, &
- & c_comm_type, &
- & r_clock
- ! EOF
- IF ( i_err == -1 ) cycle
- !
- ! if ( i == 2 ) write(6,*) ' file ', TRIM(c_verif), TRIM(c_field_code)
- ! Skip if initial synchro
- IF ( c_field_code(1:3) == "IT " ) cycle
- ! Read model names
- IF ( c_field_code(1:3) == "MD " ) THEN
- IF ( TRIM(model_name(i)) == "none" ) model_name(i) = TRIM(c_dummy)
- cycle
- ENDIF
- IF ( c_field_code(1:3) == "NP " ) cycle
-
- ! Read field names as declared in namcouple
- IF ( c_field_code(1:3) == "SN " .or. c_field_code(1:3) == "RC " ) THEN
- BACKSPACE(10)
- READ(10, '(A9,A3,A5,A)', iostat=i_err) &
- & c_verif, &
- & c_field_code, &
- & c_dummy, &
- & c_field_name
- IF ( j == 0 ) THEN
- read(c_dummy(1:4),'(i4)') k
- field_name(i,k) = TRIM(c_field_name)
- ENDIF
- cycle
- ENDIF
-
- BACKSPACE(10)
- READ(10, '(A20,A3,A16,F16.5)', iostat=i_err) &
- & c_verif, &
- & c_field_code, &
- & c_comm_type, &
- & r_clock
- ! Skip if interpolation time measurement
- IF ( INDEX ( TRIM(c_comm_type),'rpo' ) /= 0 ) cycle
- !
- ! PROCESS INFORMATION FROM STANDARD TIMING LINE
- !
- ! When coupling field list is empty (beginning)
- IF ( i_cpl_field(i) == 0 ) THEN
- ! Fill list with first field found
- i_cpl_field(i) = 1
- READ(c_field_code,'(i3)') field_code(i, i_cpl_field(i))
- ! Start counting coupling steps
- comm_nb(i,i_cpl_field(i)) = 1
- ! if ( i == 2 ) write(6,*) ' field ', TRIM(field_code(i, 1)), comm_nb(i,1)
- ! Identify if it is a put or a get communication
- IF ( INDEX ( TRIM(c_comm_type), c_ident_put ) /= 0 ) THEN
- ! This communication is a put
- comm_type(i, i_cpl_field(i)) = 0
- start_time(i,i_cpl_field(i)) = r_clock
- ELSE
- ! This communication is a get
- comm_type(i, i_cpl_field(i)) = 1
- start_time(i,i_cpl_field(i)) = r_clock
- ENDIF
- ! When field list is not empty (loop)
- ELSE
- ! Coupling field index initialized
- mi = 1
- newf = 0
- ! Check model field number already identified
- DO WHILE ( mi <= i_cpl_field(i) )
- read(c_field_code,'(i3)') tmp_field_code
- IF ( field_code(i, mi) == tmp_field_code ) &
- newf = mi
- mi = mi + 1
- END DO
- ! Another field found because not identified in the list
- IF ( newf == 0 ) THEN
- ! Fill list with new field found (same than above)
- i_cpl_field(i) = i_cpl_field(i) + 1
- READ(c_field_code,'(i3)') field_code(i, i_cpl_field(i))
- comm_nb(i,i_cpl_field(i)) = 1
- ! Identify if it is a put or a get communication
- IF ( INDEX ( TRIM(c_comm_type), c_ident_put ) /= 0 ) THEN
- ! This communication is a put
- comm_type(i, i_cpl_field(i)) = 0
- start_time(i,i_cpl_field(i)) = r_clock
- ELSE
- comm_type(i, i_cpl_field(i)) = 1
- start_time(i,i_cpl_field(i)) = r_clock
- ENDIF
- ! Just another coupling step for an already identified field
- ELSE
- comm_nb(i,newf) = comm_nb(i,newf) + 1
- END IF
- END IF
- ! End loop on read lines
- END DO
- CLOSE(10)
- ! End loop on log files
- END DO
- write(6,*) ' '
- !
- ! write(6,*) ' nbFields ', model_name(i) , i_cpl_field(i)
- ! do k = 1, i_cpl_field(i)
- ! write(6,*) ' Field ', field_code(i, k), comm_type(i,k)
- ! ENDDO
- !
- ! End loop on models
- END DO
- !
- ! Coupling fields counterd twice (as sent and received field)
- cpl_field_nb = SUM(i_cpl_field(:))/2
- ALLOCATE ( cpl_fields ( cpl_field_nb ) )
- !
- ! write(6,*) ' nb fields ', cpl_field_nb
- ! call flush(6)
- !
- !
- DO i = 1, nb_models
- ! Count total send/received fields (divide by proc number)
- comm_nb(i,:) = comm_nb(i,:) / i_file_count(i)
- END DO
- !
- ! 3. FIND EXCHANGE ORDER
- !
- j = 1
- ! loop on coupling fields
- DO WHILE ( j <= cpl_field_nb )
- ! Find the earliest exchange
- i_first_exchg = MINLOC(start_time(:,:))
- ! Index of model doing the first exchange
- mi = i_first_exchg(1)
- ! Index of first field exchanged
- i = i_first_exchg(2)
- ! only if it is a send field
- IF ( comm_type(mi,i) == 0 ) THEN
- ! Find the exchange number in OASIS sequence (namcouple)
- cpl_fields(j)%namID = field_code ( mi, i )
- ! Set its source model
- cpl_fields(j)%source_model = mi
- ! Set how many times this coupling field has been sent
- cpl_fields(j)%source_comm_nb = comm_nb( mi, i )
- !
- DO k = 1, nb_models
- IF ( k == mi ) cycle
- IF ( ANY ( field_code ( k, 1:i_cpl_field(k) ) == cpl_fields(j)%namID)) THEN
- ! Set its target model
- cpl_fields(j)%target_model = k
- DO l = 1, i_cpl_field(k)
- IF ( field_code(k,l) == cpl_fields(j)%namID ) &
- ! Set how many times this coupling field has been received
- cpl_fields(j)%target_comm_nb = comm_nb( k, l )
- END DO
- END IF
- END DO
- j = j + 1
- END IF
- start_time(mi,i) = r_impossible_value
- END DO
- !
- write (6,*) ' '
- write (6,*) ' "Lucia" analysis '
- write (6,*) ' '
- write (6,*) ' Exchanged fields (based on first exchange): '
- !
- write (6,*) ' From model : to model '
- DO i = 1, cpl_field_nb
- write (6,*) ' ', TRIM(model_name(cpl_fields(i)%source_model)), &
- ' ( ', TRIM(field_name(cpl_fields(i)%source_model,cpl_fields(i)%namID)), &
- ' ) ', TRIM(model_name(cpl_fields(i)%target_model)), &
- ' ( ', TRIM(field_name(cpl_fields(i)%target_model,cpl_fields(i)%namID)) , ' )'
- END DO
- ! write (6,*) ' '
- ! call flush(6)
- !
- ! 4. CHECK COMMUNICATION NUMBER CONCORDANCE
- !
- do i = 1, cpl_field_nb
- IF ( cpl_fields(i)%target_comm_nb /= cpl_fields(i)%source_comm_nb ) THEN
- write(6,*) ' WARNING - Coupler exchanges: ' , &
- TRIM(field_name(cpl_fields(i)%source_model,cpl_fields(i)%namID)) , &
- ' sent ', cpl_fields(i)%source_comm_nb, &
- ' but ', TRIM(field_name(cpl_fields(i)%target_model,cpl_fields(i)%namID)) , &
- ' received ', cpl_fields(i)%target_comm_nb
- !
- ! In case of unbalanced exchange number (abnormal stop),
- ! restrain communication number according to the last valid exchange number
- !
- cpl_fields(i)%source_comm_nb = MIN ( cpl_fields(i)%target_comm_nb, cpl_fields(i)%source_comm_nb)
- cpl_fields(i)%target_comm_nb = MIN ( cpl_fields(i)%target_comm_nb, cpl_fields(i)%source_comm_nb)
- ENDIF
- end do
- !
- ! Find valid number of coupling
- !
- do j = 1, cpl_field_nb
- ! OASIS sends = OASIS receives. Count only before event (/2)
- cpl_fields(j)%target_comm_nb = MIN ( cpl_fields(j)%source_comm_nb , cpl_fields(j)%target_comm_nb ) / 2
- ! Same number of "received" and "send" exchange
- cpl_fields(j)%source_comm_nb = cpl_fields(j)%target_comm_nb
- end do
- ! Substract 1 to number of coupling tstep
- ! (last exchange ignored to avoid side effect of termination phase)
- max_comm_nb = MAXVAL ( cpl_fields(:)%source_comm_nb ) - 1
- cpl_fields(:)%source_comm_nb = cpl_fields(:)%source_comm_nb - 1
- cpl_fields(:)%target_comm_nb = cpl_fields(:)%source_comm_nb
- ! Set the maximum number of coupling tstep per model
- valid_comm_nb(:) = 0
- do i = 1, nb_models
- do j = 1, cpl_field_nb
- IF ( cpl_fields(j)%source_model == i .or. cpl_fields(j)%target_model == i ) &
- valid_comm_nb(i) = MAX(valid_comm_nb(i),cpl_fields(j)%source_comm_nb)
- end do
- end do
-
- !
- ! 5. Allocate Timing Arrays
- ! - to fill with minimum or maximum clock time among log files
- ! before and after each coupling communications (put and get)
- ! and for each coupling field
- !
- ALLOCATE ( min_clock_measure ( cpl_field_nb, max_comm_nb , 4 ) )
- ALLOCATE ( max_clock_measure ( cpl_field_nb, max_comm_nb , 4 ) )
- ! initialize min/max counters
- min_clock_measure = r_impossible_value
- max_clock_measure = r_impossible_value * (-1.)
- !
- ! - to store calculation / non calculation time
- ! for each log file of the same model
- !
- ! calc_noncalc_measure ( : , 1 ) : total 'calculation' time
- ! calc_noncalc_measure ( : , 2 ) : total time spent during send operation
- ! calc_noncalc_measure ( : , 3 ) : total time spent during receive operation
- !
- nb_tot_log_files = SUM ( i_file_count(:) )
- ALLOCATE ( calc_noncalc_measure ( nb_tot_log_files, max_comm_nb, 3 ) )
- ALLOCATE ( r_interp_measure ( nb_tot_log_files ) )
- ! initialize measures total
- calc_noncalc_measure (:,:,:) = 0
- !
- ! 6. READ AGAIN OASIS-LUCIA LOG FILES CONTAINT
- ! AND FILL ARRAYS WITH ALL CLOCK TIME MEASURES
- !
- log_nb = 0
- r_max_time = r_impossible_value * (-1.)
- r_min_time = r_impossible_value
- ! Loop on model number
- DO i = 1, nb_models
- ! Loop on log file number
- DO j = 0, nb_mpi(i), i_stride(i)
- ! Count number of log file
- log_nb = log_nb + 1
- write(log_file_name,'("lucia.",a2,".",i6.6)'),model_code(i),j
- OPEN (unit=10, &
- file=TRIM(log_file_name), &
- action="read", &
- status="OLD", &
- form="formatted", &
- iostat=i_err)
- IF ( i_err .ne. 0 ) then
- write(6,*) 'Error opening ASCII file ', TRIM(log_file_name)
- STOP
- END IF
- REWIND(10)
- l_exch_still_valid = .true.
- l_exch_not_yet_valid = .true.
- c_test_name="not"
- mi = 0
- r_interp_measure(log_nb)=0
- l_add_interp_time=.false.
- i_err=0
- ! For each line of the log file
- DO WHILE ( i_err /= -1 .and. l_exch_still_valid )
- READ(10, '(A20,A3,A16,F16.5)', iostat=i_err) &
- & c_verif, &
- & c_field_code, &
- & c_comm_type, &
- & r_clock
- IF ( i_err == -1 ) CYCLE
- ! Substract first clock measure to store anomaly instead of raw value
- ! (to avoid too big values when additionning)
- IF ( c_verif(10:12) == "IT " ) THEN
- BACKSPACE(10)
- READ(10, '(A20,A3,A7,F16.5)', iostat=i_err) &
- & c_verif, &
- & c_field_code, &
- & c_comm_type, &
- & r_clock
- r_reference = r_clock
- CYCLE
- ENDIF
- ! Skip model names
- IF ( c_verif(10:12) == "MD " ) cycle
- IF ( c_verif(10:12) == "NP " ) cycle
-
- ! Skip field names
- IF ( c_verif(10:12) == "SN " .or. c_verif(10:12) == "RC " ) cycle
-
- r_clock = r_clock - r_reference
- ! Special treatment for interpolation time :cumulated
- IF ( INDEX ( TRIM(c_comm_type), 'interpo' ) /= 0 ) then
- IF ( l_add_interp_time ) then
- r_interp_measure(log_nb) = r_interp_measure(log_nb) + r_clock
- l_add_interp_time=.false.
- ELSE
- r_interp_measure(log_nb) = r_interp_measure(log_nb) - r_clock
- l_add_interp_time=.true.
- ENDIF
- CYCLE
- ENDIF
- !
- ! PROCESS INFORMATION FROM STANDARD TIMING LINE
- !
- ! Get the name of the first field exchanged by this model
- IF ( TRIM(c_test_name) == "not" ) c_test_name=TRIM(c_field_code)
- ! write(6,*) 'c_comm_type ', c_comm_type
- ! write(6,*) 'c_test_name ', c_test_name
- ! write(6,*) 'TRIM(c_field_code) ', TRIM(c_field_code)
- !
- ! Find field name as declared in namcouple
- !
- k = 1
- DO WHILE ( k <= cpl_field_nb )
- READ(c_field_code,'(i3)') tmp_field_code
- IF ( cpl_fields(k)%namID == tmp_field_code ) &
- i_cpl = k
- k = k + 1
- END DO
- ! write(6,*) 'field number ', i_cpl
- !
- ! Determine if the exchange is a put or a get
- ! if the timing is set before or after the exchange
- l_put = .false.
- l_before = .false.
- !
- ! and attribute the corresponding index:
- ! 1: Before put
- ! 2: After put
- ! 3: Before get
- ! 4: After get
- IF ( INDEX ( TRIM(c_comm_type), c_ident_put ) /= 0 ) &
- l_put = .true.
- IF ( INDEX ( TRIM(c_comm_type), c_ident_before ) /= 0 ) &
- l_before = .true.
- IF ( l_before ) THEN
- IF ( l_put ) THEN
- clk_i = before_send
- ELSE
- clk_i = before_recv
- ENDIF
- ELSE
- IF ( l_put ) THEN
- clk_i = after_send
- ELSE
- clk_i = after_recv
- ENDIF
- ENDIF
- ! write(6,*) 'index number ', clk_i
- !
- ! Determine exchange validity
- !
- ! Measures start (coupler) the first time than a field is received
- ! This excludes restart reading sequence side effect if any
- !
- !
- IF ( l_exch_not_yet_valid .AND. cpl_fields(i_cpl)%source_comm_nb == valid_comm_nb(i) ) THEN
- l_exch_not_yet_valid = .false.
- ! Get the name of the first field exchanged by this model
- c_test_name = TRIM(c_field_code)
- ! and at what time it is
- r_min_time = MIN ( r_clock, r_min_time )
- END IF
- ! If before exchange of the first coupling field
- ! on a not yet valid exchange
- IF ( TRIM(c_field_code) == TRIM(c_test_name) .and. l_before &
- .and. .not. l_exch_not_yet_valid ) THEN
- ! Increase exchange number
- mi = mi + 1
- ! Before the last valid exchange
- IF ( mi <= valid_comm_nb(i) ) THEN
- ! calc/nocalc current index initialization
- calc_noncalc_measure ( log_nb, mi, 1 ) = &
- calc_noncalc_measure ( log_nb, mi, 1 ) - r_clock
- ENDIF
- ! After the first exchange
- IF ( mi > 1 ) THEN
- ! calc/nocalc previous index finalization
- calc_noncalc_measure ( log_nb, mi-1, 1 ) = &
- calc_noncalc_measure ( log_nb, mi-1, 1 ) + r_clock
- ENDIF
- ! Increase time counter to find timing of last exchange
- r_max_time = MAX ( r_clock, r_max_time )
- ! write(6,*) 'still valid ', l_exch_still_valid
- END IF
- ! Reach maximum number of valid exchanges
- IF ( mi > valid_comm_nb(i) ) &
- l_exch_still_valid = .false.
- ! Do not fill timer arrays if exchange not yet or no more valid
- IF ( l_exch_not_yet_valid .or. .not. l_exch_still_valid ) CYCLE
- ! write(6,*) 'not cycled ', TRIM(c_field_code)
- ! Fill mix/max array compared to previous log file measures
- min_clock_measure(i_cpl ,mi ,clk_i) = &
- MIN ( min_clock_measure(i_cpl ,mi ,clk_i), r_clock )
- max_clock_measure(i_cpl ,mi ,clk_i) = &
- MAX ( max_clock_measure(i_cpl ,mi ,clk_i), r_clock )
- ! Fill calc/noncalc array for each log file
- ! Sending time
- IF ( clk_i == after_send ) THEN
- calc_noncalc_measure ( log_nb, mi, 2 ) = &
- calc_noncalc_measure ( log_nb, mi, 2 ) + r_clock
- ELSE IF ( clk_i == before_send ) THEN
- calc_noncalc_measure ( log_nb, mi, 2 ) = &
- calc_noncalc_measure ( log_nb, mi, 2 ) - r_clock
- ! Receiving time
- ELSE IF ( clk_i == after_recv ) THEN
- calc_noncalc_measure ( log_nb, mi, 3 ) = &
- calc_noncalc_measure ( log_nb, mi, 3 ) + r_clock
- ELSE IF ( clk_i == before_recv ) THEN
- calc_noncalc_measure ( log_nb, mi, 3 ) = &
- calc_noncalc_measure ( log_nb, mi, 3 ) - r_clock
- ENDIF
- ! Calculation time
- IF ( MOD ( clk_i , after_send_or_recv ) == 1 ) THEN
- calc_noncalc_measure ( log_nb, mi, 1 ) = &
- calc_noncalc_measure ( log_nb, mi, 1 ) + r_clock
- ELSE
- calc_noncalc_measure ( log_nb, mi, 1 ) = &
- calc_noncalc_measure ( log_nb, mi, 1 ) - r_clock
- ENDIF
-
- ! End loop on read lines
- END DO
- CLOSE(10)
- ! End loop on log files
- END DO
- ! End loop on models
- END DO
- !
- ! 7. ANALYSIS
- !
- calc_time (:) = 0 ; noncalc_time (:) = 0
- send_spread (:) = 0 ; receive_spread (:) = 0; calc_spread (:) = 0
- !
- ! 7.1 ANALYSIS ON MAXIMUM MEAN VALUES AMONG LOG FILES
- !
- k = 1
- ! Loop on models
- DO i = 1, nb_models
- ! write(6,*), ' Model : ', i
- ! For most frequently coupled fields
- IF ( valid_comm_nb(i) == max_comm_nb ) THEN
- ! Start analysis on third exchange to avoid side effect
- first_valid_comm(i) = 3
- ELSE
- ! only on second for the others
- first_valid_comm(i) = 2
- END IF
- ! Special treatment for models not involved in coupling (IO servers)
- IF ( valid_comm_nb(i) == 0 ) first_valid_comm(i) = 1
- ! Loop on valid coupling tsteps
- DO j = first_valid_comm(i), valid_comm_nb(i)
- ! Maximum values over log files are added for all valid coupling tsteps
- ! ... for time spent by models on calculations
- calc_time (i) = calc_time (i) + MAXVAL(calc_noncalc_measure (k:k+i_file_count(i)-1, j, 1))
- ! ... for time spent by models on OASIS exchanges (send and receive operations)
- noncalc_time (i) = noncalc_time (i) + &
- MAXVAL(calc_noncalc_measure (k:k+i_file_count(i)-1, j, 2)) + &
- MAXVAL(calc_noncalc_measure (k:k+i_file_count(i)-1, j, 3))
- ! Variance among log file is calculated for those 2 values
- r_mean = SUM ( calc_noncalc_measure (k:k+i_file_count(i)-1, j, 2) ) / i_file_count(i)
- send_spread (i) = send_spread (i) + &
- SQRT ( SUM ( ( calc_noncalc_measure (k:k+i_file_count(i)-1, j, 2) - &
- r_mean ) ** 2 ) )
- r_mean = SUM ( calc_noncalc_measure (k:k+i_file_count(i)-1, j, 3) ) / i_file_count(i)
- receive_spread (i) = receive_spread (i) + &
- SQRT ( SUM ( ( calc_noncalc_measure (k:k+i_file_count(i)-1, j, 3) - &
- r_mean ) ** 2 ) )
- r_mean = SUM ( calc_noncalc_measure (k:k+i_file_count(i)-1, j, 1) ) / i_file_count(i)
- calc_spread (i) = calc_spread (i) + &
- SQRT ( SUM ( ( calc_noncalc_measure (k:k+i_file_count(i)-1, j, 1) - &
- r_mean ) ** 2 ) )
- !
- END DO
- ! Time spent on OASIS interpolation is a mean value among log files
- r_interp_time(i) = SUM(r_interp_measure(k:k+i_file_count(i)-1))/i_file_count(i)
- ! Counter on log file index among total log file number
- k = k + i_file_count(i)
- END DO
- !
- ! WRITE INFO ON STANDARD OUTPUT
- !
- ! Old analysis, no more active
- !
- ! WRITE(6,*) ' '
- ! WRITE(6,*), ' Component - Computation - Waiting time (s) - # cpl step '
- ! DO i = 1, nb_models
- ! WRITE(6,'(2X, A6, 5X, F10.2, A7, F6.2, A3, 5X, F10.2, A7, F6.2, A4, I4)'), &
- ! model_name(i), &
- ! calc_time(i), &
- ! ' ( +/- ', calc_spread(i) , ' ) ', &
- ! noncalc_time(i), &
- ! ' ( +/- ', send_spread(i)+receive_spread(i), ' ) ', &
- ! valid_comm_nb(i)-first_valid_comm(i)+1
- ! END DO
- ! WRITE(6,*), ' '
- ! call flush(6)
- !
- ! 7.2 ANALYSIS ON BOUNDARY VALUES AMONG LOG FILES
- !
- !
- r_min_time = 0. ; r_max_time = 0.
- !
- calc_time(:) = 0.
- noncalc_time(:) = 0.
- calc_time(:) = 0.
- r_jitter_time(:) = 0.
- ! loop on models
- DO k = 1, nb_models
- ! loop on coupling fields
- DO i = 1, cpl_field_nb
- ! If sent field
- IF ( cpl_fields(i)%source_model == k ) THEN
- ! loop on coupling time steps
- ! WARNING valid_comm_nb depends on cpl_field_nb (if different model
- ! with diff cpl time step)
- DO j = first_valid_comm(k), valid_comm_nb(k)
- ! If a timing is available for this coupling field at this coupling time step
- IF ( max_clock_measure (i,j,2) < r_test_impossible .and. max_clock_measure (i,j,1) < r_test_impossible ) &
- ! add sending time to the total of non calculation time
- noncalc_time(k) = max_clock_measure (i,j,2) - max_clock_measure (i,j,1) + &
- noncalc_time(k)
- ! WARNING : sending time starts when slowest mpi process check on log files is before sending
- ! and stops when slowest mpi process check on log files is after sending
- IF ( max_clock_measure (i,j,1) < r_test_impossible .and. ABS(min_clock_measure (i,j,1)) < r_test_impossible ) &
- ! Measure before sending between slowest and fastest mpi process check on log files
- r_jitter_time(k) = max_clock_measure (i,j,1) - min_clock_measure (i,j,1) + &
- r_jitter_time(k)
- ENDDO
- ! If received field
- ELSE IF ( cpl_fields(i)%target_model == k ) THEN
- ! loop on coupling time steps
- ! WARNING valid_comm_nb depends on cpl_field_nb (if different model
- ! with diff cpl time step)
- DO j = first_valid_comm(k), valid_comm_nb(k)
- ! If a timing is available for this coupling field at this coupling time step
- IF ( max_clock_measure (i,j,4) < r_test_impossible .and. max_clock_measure (i,j,3) < r_test_impossible ) &
- ! add receiving time to the total of non calculation time
- noncalc_time(k) = max_clock_measure (i,j,4) - max_clock_measure (i,j,3) + &
- noncalc_time(k)
- ! WARNING : receiving time starts when slowest mpi process check on log files is before receiving
- ! and stops when slowest mpi process check on log files is after receiving
- IF ( max_clock_measure (i,j,3) < r_test_impossible .and. ABS(min_clock_measure (i,j,3)) < r_test_impossible ) &
- ! Measure before receiving between slowest and fastest mpi process check on log files
- r_jitter_time(k) = max_clock_measure (i,j,3) - min_clock_measure (i,j,3) + &
- r_jitter_time(k)
- ENDDO
- ENDIF
- ENDDO
- !
- r_min_time = r_impossible_value * (-1.)
- r_max_time = r_impossible_value * (-1.)
- ! CALCULATE TIME BOUNDS
- l_put = .true.
- ! Loop on coupling fields
- DO i = 1, cpl_field_nb
- ! on target model
- IF ( cpl_fields(i)%target_model == k ) THEN
- ! Measure first valid time when field received (after receiving)
- temp_t = max_clock_measure(i,first_valid_comm(k)-1,4)
- ! If later than reference
- IF ( temp_t > r_min_time .and. temp_t < r_test_impossible ) &
- ! Set it as reference
- r_min_time = temp_t
- ! Measure last valid time when field received (after receiving)
- temp_t = max_clock_measure(i,valid_comm_nb(k),4)
- ! If later than reference
- IF ( temp_t > r_max_time .and. temp_t < r_test_impossible ) &
- ! Set it as reference
- r_max_time = temp_t
- l_put = .false.
- ENDIF
- ENDDO
- ! IF NO RECEIVED FIELD ON MODEL DO THE SAME THAN PREVIOUSLY BUT WITH SENT FIELDS
- IF ( l_put ) THEN
- ! Loop on coupling fields
- DO i = 1, cpl_field_nb
- ! on target model
- IF ( cpl_fields(i)%source_model == k ) THEN
- ! Measure first valid time when field received (after receiving)
- temp_t = max_clock_measure(i,first_valid_comm(k)-1,2)
- ! If later than reference
- IF ( temp_t > r_min_time .and. temp_t < r_test_impossible ) &
- ! Set it as reference
- r_min_time = temp_t
- ! Measure last valid time when field received (after receiving)
- temp_t = max_clock_measure(i,valid_comm_nb(k),2)
- ! If later than reference
- IF ( temp_t > r_max_time .and. temp_t < r_test_impossible ) &
- ! Set it as reference
- r_max_time = temp_t
- ENDIF
- ENDDO
- ENDIF
- !
- ! CALCULATION TIME defined as total time minus OASIS communication time
- calc_time(k) = r_max_time - r_min_time - noncalc_time(k)
- ! End loop on models
- ENDDO
- !
- WRITE(6,*) ' '
- WRITE(6,*), ' Load balance analysis '
- WRITE(6,*) ' '
- WRITE(6,*), ' Component - Calculations - Waiting time (s) - # cpl step :'
- !
- ! WRITE INFO ON DAT FILE FOR GNUPLOT AND STANDARD OUTPUT
- !
- WRITE(6,*) ' '
- OPEN (10, file="info.dat")
- DO i = 1, nb_models
- WRITE(10,'(I2, 2X, F10.3, 2X, F10.3, 2X, A6)'), &
- i, calc_time(i), noncalc_time(i), model_name(i)
- WRITE(6,'(2X, A6, 16X, F10.2, 12X, F10.2, 10X, I4)'), &
- model_name(i), calc_time(i), noncalc_time(i), valid_comm_nb(i)-first_valid_comm(i)+1
- ENDDO
- CLOSE (10)
-
- WRITE (6,*) ' '
- !
- WRITE(6,*), ' Additional informations'
- WRITE(6,*), ' Component - OASIS mean interpolation time - Jitter (s): '
- DO i = 1, nb_models
- WRITE(6,'(2X, A6, 12X, F10.2, 18X, F10.2 )'), &
- model_name(i), r_interp_time(i), r_jitter_time(i)
- END DO
- !
- WRITE (6,*) ' '
- WRITE (6,*) ' lucia completed successfully '
- WRITE (6,*) ' '
- end program lucia_analysis
|