00001
00002
00003
00004
00005
00006
00007
00008
00009
00010 subroutine psmile_smioc_init(cda_comp_name, il_comp_id, id_err)
00011
00012
00013
00014
00015 USE PSMILe_smioc
00016 USE PSMILe_smioc_interface
00017
00018 IMPLICIT NONE
00019
00020
00021
00022
00023 CHARACTER (LEN=256), INTENT(In) :: cda_comp_name
00024
00025 INTEGER, INTENT (IN) :: il_comp_id
00026
00027
00028
00029 INTEGER, INTENT (Out) :: id_err
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052 INTEGER :: sasa_c_read_file, sasa_c_close
00053
00054 CHARACTER(LEN=80), SAVE :: mycvs =
00055 '$Id'
00056
00057 CHARACTER (LEN=256) :: cla_smioc_file
00058
00059 INTEGER :: il_smioc_recv_size_i, il_smioc_recv_size_c, il_smioc_recv_size_d
00060 INTEGER :: il_index_i, il_index_c, il_index_d
00061
00062 INTEGER :: il_nb_int_i_fix, il_nb_int_i_in, il_nb_int_i_out
00063 INTEGER :: il_nb_int_d_fix, il_nb_int_d_in, il_nb_int_d_out
00064 INTEGER :: il_nb_int_c_fix, il_nb_int_c_in, il_nb_int_c_out
00065 INTEGER :: il_igrid
00066
00067 INTEGER, DIMENSION(:), ALLOCATABLE :: ila_smioc_recv
00068 CHARACTER (LEN=256), DIMENSION(:), ALLOCATABLE :: cla_smioc_recv
00069 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: dla_smioc_recv
00070 REAL, DIMENSION(:), ALLOCATABLE :: rla_smioc_recv
00071
00072
00073 INTEGER :: ib_ntt, ib, ib_bis, ib_ter
00074 INTEGER :: ib_ntt2, ib_nin, ib_nout, ib_transi
00075 INTEGER :: ib_grid
00076
00077
00078 INTEGER :: ib_p, il_combi, il_source
00079 INTEGER :: il_npartinid, il_npartoutid
00080
00081
00082 LOGICAL :: ll_combi, ll_source
00083
00084
00085 LOGICAL :: ll_userdef_details
00086
00087
00088 LOGICAL :: ll_first_details
00089
00090 INTEGER :: il_status(MPI_STATUS_SIZE)
00091 INTEGER :: il_chanel, il_index
00092 INTEGER :: il_smioc_len
00093 INTEGER :: il_compid
00094
00095
00096 INTEGER, DIMENSION(7) :: ila_dim_size
00097
00098 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_orig_comp_id
00099 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_dest_comp_id
00100 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_combi_loc
00101 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_trans_orig_id
00102 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_trans_dest_id
00103
00104 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_cpl_rst_file
00105 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: dla_cpl_rst_file
00106 CHARACTER(len=max_name), DIMENSION(:,:), ALLOCATABLE :: cla_cpl_rst_file
00107
00108 INTEGER, DIMENSION(:,:), ALLOCATABLE :: ila_trans_interp
00109 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: dla_trans_interp
00110 CHARACTER(len=max_name), DIMENSION(:,:), ALLOCATABLE :: cla_trans_interp
00111
00112
00113 INTEGER, DIMENSION(:), ALLOCATABLE :: ila_comp_nb_stand_name
00114 INTEGER, DIMENSION(:), ALLOCATABLE :: ila_comp_nb_transi_in
00115 INTEGER, DIMENSION(:), ALLOCATABLE :: ila_comp_nb_transi_out
00116
00117
00118 INTEGER, PARAMETER :: nerrp = 2
00119 INTEGER :: ierrp (nerrp)
00120
00121 #ifdef DEBUG
00122 CHARACTER(len=max_name) :: file_name
00123 INTEGER :: my_rank
00124 INTEGER :: il_len
00125 #endif
00126
00127
00128
00129
00130
00131 #ifdef VERBOSE
00132 print 9990, trim(ch_id), il_comp_id
00133
00134 call psmile_flushstd
00135 #endif /* VERBOSE */
00136
00137
00138
00139
00140 #ifdef DEBUG
00141 CALL MPI_Comm_rank( MPI_COMM_WORLD, my_rank, id_err )
00142 il_chanel = 31
00143 WRITE(file_name,'(a,a17)') TRIM(cda_comp_name), '_smioc.debug.0000'
00144 il_len = LEN_TRIM(file_name)
00145 IF ( my_rank < 10 ) THEN
00146 WRITE(file_name(il_len :il_len),'(i1)') my_rank
00147 ELSE IF ( my_rank < 100 ) THEN
00148 WRITE(file_name(il_len-1:il_len),'(i2)') my_rank
00149 ELSE IF ( my_rank < 1000 ) THEN
00150 WRITE(file_name(il_len-2:il_len),'(i3)') my_rank
00151 ELSE IF ( my_rank < 10000 ) THEN
00152 WRITE(file_name(il_len-3:il_len),'(i4)') my_rank
00153 ENDIF
00154 OPEN(FILE=file_name,FORM='FORMATTED',UNIT=il_chanel)
00155 #endif
00156
00157
00158
00159
00160
00161 #ifdef DEBUG
00162 WRITE(il_chanel,*) ' '
00163 WRITE(il_chanel,*) '* Get the dimensionning numbers'
00164 #endif
00165
00166
00167 IF ( .NOT. ALLOCATED(iga_comp_id_doc_XML) ) &
00168 ALLOCATE( iga_comp_id_doc_XML(1), stat=id_err )
00169 IF (id_err > 0) THEN
00170 ierrp (1) = id_err
00171 ierrp (2) = 1
00172 id_err = 13
00173
00174 CALL PSMILe_Error ( id_err, 'iga_comp_id_doc_XML', &
00175 ierrp, 2, __FILE__, __LINE__ )
00176 RETURN
00177 ENDIF
00178
00179
00180 IF ( .NOT. ALLOCATED(iga_comp_nb_grids) ) &
00181 ALLOCATE( iga_comp_nb_grids(1), stat=id_err )
00182 IF (id_err > 0) THEN
00183 ierrp (1) = id_err
00184 ierrp (2) = 1
00185 id_err = 13
00186
00187 call psmile_error ( id_err, 'iga_comp_nb_grids', &
00188 ierrp, 2, __FILE__, __LINE__ )
00189 RETURN
00190 ENDIF
00191 IF ( .NOT. ALLOCATED(iga_comp_nb_transi) ) &
00192 ALLOCATE( iga_comp_nb_transi(1), stat=id_err )
00193 IF (id_err > 0) THEN
00194 ierrp (1) = id_err
00195 ierrp (2) = 1
00196 id_err = 13
00197
00198 call psmile_error ( id_err, 'iga_comp_nb_transi', &
00199 ierrp, 2, __FILE__, __LINE__ )
00200 RETURN
00201 ENDIF
00202 IF ( .NOT. ALLOCATED(iga_comp_nb_persis) ) &
00203 ALLOCATE( iga_comp_nb_persis(1), stat=id_err )
00204 IF (id_err > 0) THEN
00205 ierrp (1) = id_err
00206 ierrp (2) = 1
00207 id_err = 13
00208
00209 call psmile_error ( id_err, 'iga_comp_nb_persis', &
00210 ierrp, 2, __FILE__, __LINE__ )
00211 RETURN
00212 ENDIF
00213 IF ( .NOT. ALLOCATED(iga_comp_nb_unitsets) ) &
00214 ALLOCATE( iga_comp_nb_unitsets(1), stat=id_err )
00215 IF (id_err > 0) THEN
00216 ierrp (1) = id_err
00217 ierrp (2) = 1
00218 id_err = 13
00219
00220 call psmile_error ( id_err, 'iga_comp_nb_unitsets', &
00221 ierrp, 2, __FILE__, __LINE__ )
00222 RETURN
00223 ENDIF
00224 IF ( .NOT. ALLOCATED(iga_comp_nb_udef) ) &
00225 ALLOCATE( iga_comp_nb_udef(1), stat=id_err )
00226 IF (id_err > 0) THEN
00227 ierrp (1) = id_err
00228 ierrp (2) = 1
00229 id_err = 13
00230
00231 call psmile_error ( id_err, 'iga_comp_nb_udef', &
00232 ierrp, 2, __FILE__, __LINE__ )
00233 RETURN
00234 ENDIF
00235
00236
00237
00238
00239 #ifdef DEBUG
00240 WRITE(il_chanel,*) ' Component ', cda_comp_name
00241 #endif
00242
00243 IF (Appl%stand_alone) THEN
00244
00245 #ifdef CIM
00246
00247 iga_comp_id_doc_XML(1) = sasa_c_read_file ("cim.xml", 7)
00248 #else
00249
00250 cla_smioc_file = TRIM(Appl%name)//"_"//TRIM(cda_comp_name)//"_smioc.xml"
00251 il_smioc_len = LEN_TRIM(Appl%name) + 1 + LEN_TRIM(cda_comp_name) + 10
00252
00253
00254 iga_comp_id_doc_XML(1) = sasa_c_read_file (cla_smioc_file, il_smioc_len)
00255 #endif
00256
00257 il_compid = 1
00258 ll_userdef_details = .false.
00259 CALL get_smioc_numbers ( iga_comp_id_doc_XML(1), &
00260 iga_comp_nb_unitsets(1), &
00261 iga_comp_nb_grids(1), &
00262 iga_comp_nb_transi(1), &
00263 iga_comp_nb_persis(1), &
00264 il_compid, &
00265 Appl%name, &
00266 cda_comp_name, &
00267 ll_userdef_details, &
00268 id_err )
00269 IF (id_err .ne. 0) WRITE(il_chanel,*) 'WARNING: Pb in get_smioc_numbers'
00270
00271 #ifdef DEBUG
00272 WRITE(il_chanel,*) ' Nb of Fortran unit sets ', iga_comp_nb_unitsets(1)
00273 WRITE(il_chanel,*) ' Nb of grids ', iga_comp_nb_grids(1)
00274 WRITE(il_chanel,*) ' Nb of transients ', iga_comp_nb_transi(1)
00275 WRITE(il_chanel,*) ' Nb of persistents ', iga_comp_nb_persis(1)
00276 WRITE(il_chanel,*) ' '
00277 call psmile_flushstd(il_chanel)
00278 #endif
00279
00280 ELSE
00281
00282 ALLOCATE(ila_smioc_recv(4), stat=id_err)
00283 IF (id_err > 0) THEN
00284 ierrp (1) = id_err
00285 ierrp (2) = 4
00286 id_err = 13
00287
00288 call psmile_error ( id_err, 'ila_smioc_recv', &
00289 ierrp, 2, __FILE__, __LINE__ )
00290 RETURN
00291 ENDIF
00292
00293 CALL MPI_Recv (ila_smioc_recv, 4, MPI_Integer, &
00294 PRISMdrv_root, 1, comm_trans, il_status, id_err)
00295
00296 IF (id_err .ne. 0) &
00297 WRITE(il_chanel,*) 'WARNING: Pb in get_smioc_numbers'
00298
00299 iga_comp_nb_unitsets(1) = ila_smioc_recv(1)
00300 iga_comp_nb_grids(1) = ila_smioc_recv(2)
00301 iga_comp_nb_transi(1) = ila_smioc_recv(3)
00302 iga_comp_nb_persis(1) = ila_smioc_recv(4)
00303
00304 #ifdef DEBUG
00305 WRITE(il_chanel,*) ' Nb of Fortran unit sets ', &
00306 iga_comp_nb_unitsets(1)
00307 WRITE(il_chanel,*) ' Nb of grids ', iga_comp_nb_grids(1)
00308 WRITE(il_chanel,*) ' Nb of transients ', iga_comp_nb_transi(1)
00309 WRITE(il_chanel,*) ' Nb of persistents ', iga_comp_nb_persis(1)
00310 WRITE(il_chanel,*) ' '
00311 call psmile_flushstd(il_chanel)
00312 #endif
00313
00314 DEALLOCATE(ila_smioc_recv, stat=id_err)
00315 IF (id_err > 0) THEN
00316 ierrp (1) = id_err
00317 id_err = 14
00318
00319 call psmile_error ( id_err, 'ila_smioc_recv', &
00320 ierrp, 1, __FILE__, __LINE__ )
00321 RETURN
00322 ENDIF
00323
00324
00325
00326 END IF
00327
00328 #ifdef DEBUG
00329 WRITE(il_chanel,*) ' '
00330 WRITE(il_chanel,*) ' Got the dimensionning numbers'
00331 call psmile_flushstd(il_chanel)
00332 #endif
00333
00334
00335 ALLOCATE ( sga_smioc_comp(il_comp_id)%iga_smioc_unitsets (iga_comp_nb_unitsets(1), 3), stat=id_err )
00336 IF (id_err > 0) THEN
00337 ierrp (1) = id_err
00338 ierrp (2) = iga_comp_nb_unitsets(1)
00339 id_err = 13
00340
00341 call psmile_error ( id_err, 'iga_smioc_unitsets', &
00342 ierrp, 2, __FILE__, __LINE__ )
00343 RETURN
00344 ENDIF
00345
00346 ALLOCATE ( sga_smioc_comp(il_comp_id)%sga_smioc_grids (iga_comp_nb_grids(1)), stat=id_err )
00347 IF (id_err > 0) THEN
00348 ierrp (1) = id_err
00349 ierrp (2) = iga_comp_nb_grids(1)
00350 id_err = 13
00351
00352 call psmile_error ( id_err, 'sga_smioc_grids', &
00353 ierrp, 2, __FILE__, __LINE__ )
00354 RETURN
00355 ENDIF
00356
00357 ALLOCATE ( sga_smioc_comp(il_comp_id)%sga_smioc_transi (iga_comp_nb_transi(1)), stat=id_err )
00358 IF (id_err > 0) THEN
00359 ierrp (1) = id_err
00360 ierrp (2) = iga_comp_nb_transi(1)
00361 id_err = 13
00362
00363 call psmile_error ( id_err, 'sga_smioc_transi', &
00364 ierrp, 2, __FILE__, __LINE__ )
00365 RETURN
00366 ENDIF
00367
00368 ALLOCATE ( sga_smioc_comp(il_comp_id)%sga_smioc_persis (iga_comp_nb_persis(1)) , stat=id_err)
00369 IF (id_err > 0) THEN
00370 ierrp (1) = id_err
00371 ierrp (2) = iga_comp_nb_persis(1)
00372 id_err = 13
00373
00374 call psmile_error ( id_err, 'sga_smioc_persis', &
00375 ierrp, 2, __FILE__, __LINE__ )
00376 RETURN
00377 ENDIF
00378
00379 iga_smioc_unitsets => sga_smioc_comp(il_comp_id)%iga_smioc_unitsets
00380 sga_smioc_grids => sga_smioc_comp(il_comp_id)%sga_smioc_grids
00381 sga_smioc_transi => sga_smioc_comp(il_comp_id)%sga_smioc_transi
00382 sga_smioc_persis => sga_smioc_comp(il_comp_id)%sga_smioc_persis
00383
00384 #ifdef DEBUG
00385 WRITE(il_chanel,*) ' '
00386 WRITE(il_chanel,*) '* Global structures allocated'
00387 call psmile_flushstd(il_chanel)
00388 #endif
00389
00390
00391
00392
00393
00394
00395 #ifdef DEBUG
00396 WRITE(il_chanel,*) ' '
00397 WRITE(il_chanel,*) '* Get the Fortran unit sets component per component'
00398 #endif
00399
00400 IF (iga_comp_nb_unitsets(1) .gt. 0) THEN
00401
00402
00403 IF (Appl%stand_alone) THEN
00404 #ifdef CIM
00405 iga_comp_nb_unitsets(1) = 0
00406 #else
00407 CALL get_unitsets_details ( iga_comp_id_doc_XML(1), &
00408 iga_comp_nb_unitsets(1), &
00409 iga_smioc_unitsets(1:iga_comp_nb_unitsets(1),:), &
00410 id_err )
00411 IF (id_err .ne. 0) &
00412 WRITE(il_chanel,*) 'WARNING: Pb in get_unitsets_details'
00413 #endif
00414 ELSE
00415
00416 ALLOCATE(ila_smioc_recv(iga_comp_nb_unitsets(1)*3), stat=id_err)
00417 IF (id_err > 0) THEN
00418 ierrp (1) = id_err
00419 ierrp (2) = iga_comp_nb_unitsets(1)*3
00420 id_err = 13
00421
00422 call psmile_error ( id_err, 'ila_smioc_recv', &
00423 ierrp, 2, __FILE__, __LINE__ )
00424 RETURN
00425 ENDIF
00426
00427 CALL MPI_Recv (ila_smioc_recv, iga_comp_nb_unitsets(1)*3, &
00428 MPI_Integer, PRISMdrv_root, 2, comm_trans, &
00429 il_status, id_err)
00430
00431 IF (id_err .ne. 0) &
00432 WRITE(il_chanel,*) 'WARNING: Pb in get_unitsets_details'
00433
00434 il_index = 1
00435 DO ib= 1, iga_comp_nb_unitsets(1)
00436
00437 iga_smioc_unitsets(ib,1) = ila_smioc_recv(il_index)
00438 iga_smioc_unitsets(ib,2) = ila_smioc_recv(il_index+1)
00439 iga_smioc_unitsets(ib,3) = ila_smioc_recv(il_index+2)
00440
00441 il_index = il_index + 3
00442
00443 END DO
00444
00445 DEALLOCATE(ila_smioc_recv, stat=id_err)
00446 IF (id_err > 0) THEN
00447 ierrp (1) = id_err
00448 id_err = 14
00449
00450 call psmile_error ( id_err, 'ila_smioc_recv', &
00451 ierrp, 1, __FILE__, __LINE__ )
00452 RETURN
00453 ENDIF
00454 END IF
00455 END IF
00456
00457 #ifdef DEBUG
00458 WRITE(il_chanel,*) ' '
00459 WRITE(il_chanel,*) ' Got the Fortran unit sets component per component'
00460 call psmile_flushstd(il_chanel)
00461 #endif
00462
00463
00464
00465
00466
00467
00468 #ifdef DEBUG
00469 WRITE(il_chanel,*) ' '
00470 WRITE(il_chanel,*) '* Get the grids details component per component'
00471 #endif
00472
00473 IF (iga_comp_nb_grids(1) .gt. 0) THEN
00474
00475 CALL init_grids (iga_comp_nb_grids(1), sga_smioc_grids, id_err )
00476 IF (id_err .ne. 0) WRITE(il_chanel,*) 'WARNING: Pb in init_grids'
00477
00478 IF (Appl%stand_alone) THEN
00479
00480 CALL get_grids_details ( iga_comp_id_doc_XML(1), &
00481 iga_comp_nb_grids(1), &
00482 Appl%name, &
00483 cda_comp_name, &
00484 sga_smioc_grids(1:iga_comp_nb_grids(1)), &
00485 id_err )
00486 IF (id_err .ne. 0) &
00487 WRITE(il_chanel,*) 'WARNING: Pb in get_grids_details'
00488
00489 sga_smioc_grids(:)%ig_comp_id = 1
00490 DO ib = 1, iga_comp_nb_grids(1)
00491 sga_smioc_grids(ib)%ig_grid_id = ib
00492 ENDDO
00493
00494 ELSE
00495
00496 ALLOCATE(ila_smioc_recv(5*iga_comp_nb_grids(1)), stat=id_err)
00497 IF (id_err > 0) THEN
00498 ierrp (1) = id_err
00499 ierrp (2) = 3*iga_comp_nb_grids(1)
00500 id_err = 13
00501
00502 call psmile_error ( id_err, 'ila_smioc_recv', &
00503 ierrp, 2, __FILE__, __LINE__ )
00504 RETURN
00505 ENDIF
00506 ALLOCATE(cla_smioc_recv(iga_comp_nb_grids(1)), stat=id_err)
00507 IF (id_err > 0) THEN
00508 ierrp (1) = id_err
00509 ierrp (2) = iga_comp_nb_grids(1)
00510 id_err = 13
00511
00512 call psmile_error ( id_err, 'cla_smioc_recv', &
00513 ierrp, 2, __FILE__, __LINE__ )
00514 RETURN
00515 ENDIF
00516
00517 CALL MPI_Recv (ila_smioc_recv, 5*iga_comp_nb_grids(1), &
00518 MPI_Integer, PRISMdrv_root, 3, comm_trans, &
00519 il_status, id_err)
00520
00521 CALL MPI_Recv (cla_smioc_recv, max_name*iga_comp_nb_grids(1), &
00522 MPI_Character, PRISMdrv_root, 4, comm_trans, &
00523 il_status, id_err)
00524
00525 IF (id_err .ne. 0) &
00526 WRITE(il_chanel,*) 'WARNING: Pb in get_grids_details'
00527
00528 il_index = 1
00529 DO ib= 1, iga_comp_nb_grids(1)
00530
00531 sga_smioc_grids(ib)%ig_grid_id = ila_smioc_recv(1 + (ib-1)*5)
00532 sga_smioc_grids(ib)%ig_comp_id = ila_smioc_recv(2 + (ib-1)*5)
00533 DO ib_bis = 1, 3
00534 sga_smioc_grids(ib)%iga_periodic(ib_bis) = &
00535 ila_smioc_recv(2 + ib_bis + (ib-1)*5)
00536 END DO
00537
00538 sga_smioc_grids(ib)%cg_grid_name = cla_smioc_recv(ib)
00539
00540 END DO
00541
00542 DEALLOCATE(ila_smioc_recv, stat=id_err)
00543 IF (id_err > 0) THEN
00544 ierrp (1) = id_err
00545 id_err = 14
00546
00547 call psmile_error ( id_err, 'ila_smioc_recv', &
00548 ierrp, 1, __FILE__, __LINE__ )
00549 RETURN
00550 ENDIF
00551 DEALLOCATE(cla_smioc_recv, stat=id_err)
00552 IF (id_err > 0) THEN
00553 ierrp (1) = id_err
00554 id_err = 14
00555
00556 call psmile_error ( id_err, 'cla_smioc_recv', &
00557 ierrp, 1, __FILE__, __LINE__ )
00558 RETURN
00559 ENDIF
00560 END IF
00561 END IF
00562
00563 #ifdef DEBUG
00564 WRITE(il_chanel,*) ' '
00565 WRITE(il_chanel,*) ' Got the grids details component per component'
00566 call psmile_flushstd(il_chanel)
00567 #endif
00568
00569
00570
00571
00572
00573
00574
00575 #ifdef DEBUG
00576 WRITE(il_chanel,*) ' '
00577 WRITE(il_chanel,*) '* Get the transient numbers '
00578 #endif
00579
00580 IF (iga_comp_nb_transi(1) .gt. 0) THEN
00581
00582
00583
00584 ALLOCATE (ila_comp_nb_stand_name(iga_comp_nb_transi(1)), stat=id_err)
00585 IF (id_err > 0) THEN
00586 ierrp (1) = id_err
00587 ierrp (2) = iga_comp_nb_transi(1)
00588 id_err = 13
00589
00590 call psmile_error ( id_err, 'ila_comp_nb_stand_name', &
00591 ierrp, 2, __FILE__, __LINE__ )
00592 RETURN
00593 ENDIF
00594 ALLOCATE (ila_comp_nb_transi_in(iga_comp_nb_transi(1)), stat=id_err)
00595 IF (id_err > 0) THEN
00596 ierrp (1) = id_err
00597 ierrp (2) = iga_comp_nb_transi(1)
00598 id_err = 13
00599
00600 call psmile_error ( id_err, 'ila_comp_nb_transi_in', &
00601 ierrp, 2, __FILE__, __LINE__ )
00602 RETURN
00603 ENDIF
00604 ALLOCATE (ila_comp_nb_transi_out(iga_comp_nb_transi(1)), stat=id_err)
00605 IF (id_err > 0) THEN
00606 ierrp (1) = id_err
00607 ierrp (2) = iga_comp_nb_transi(1)
00608 id_err = 13
00609
00610 call psmile_error ( id_err, 'ila_comp_nb_transi_out', &
00611 ierrp, 2, __FILE__, __LINE__ )
00612 RETURN
00613 ENDIF
00614
00615
00616
00617 IF (Appl%stand_alone) THEN
00618 il_compid = 1
00619 ll_first_details = .true.
00620 CALL get_transi_io_numbers ( iga_comp_id_doc_XML(1), &
00621 iga_comp_nb_transi(1), &
00622 ila_comp_nb_stand_name(:), &
00623 ila_comp_nb_transi_in(:), &
00624 ila_comp_nb_transi_out(:), &
00625 il_compid, &
00626 Appl%name, &
00627 cda_comp_name, &
00628 ll_first_details, &
00629 id_err )
00630 IF (id_err .ne. 0) &
00631 WRITE(il_chanel,*) 'WARNING: Pb in get_transi_io_numbers'
00632
00633 ELSE
00634
00635 ALLOCATE(ila_smioc_recv(3*iga_comp_nb_transi(1)), stat=id_err)
00636 IF (id_err > 0) THEN
00637 ierrp (1) = id_err
00638 ierrp (2) = 3*iga_comp_nb_transi(1)
00639 id_err = 13
00640
00641 call psmile_error ( id_err, 'ila_smioc_recv', &
00642 ierrp, 2, __FILE__, __LINE__ )
00643 RETURN
00644 ENDIF
00645
00646 CALL MPI_Recv (ila_smioc_recv, 3*iga_comp_nb_transi(1), &
00647 MPI_Integer, PRISMdrv_root, 6, comm_trans, &
00648 il_status, id_err)
00649
00650 DO ib = 1, iga_comp_nb_transi(1)
00651
00652 ila_comp_nb_stand_name(ib) = ila_smioc_recv(1 + (ib-1)*3)
00653 ila_comp_nb_transi_in(ib) = ila_smioc_recv(2 + (ib-1)*3)
00654 ila_comp_nb_transi_out(ib) = ila_smioc_recv(3 + (ib-1)*3)
00655
00656 END DO
00657
00658 DEALLOCATE(ila_smioc_recv, stat=id_err)
00659 IF (id_err > 0) THEN
00660 ierrp (1) = id_err
00661 id_err = 14
00662
00663 call psmile_error ( id_err, 'ila_smioc_recv', &
00664 ierrp, 1, __FILE__, __LINE__ )
00665 RETURN
00666 ENDIF
00667 END IF
00668
00669
00670
00671 DO ib_ntt = 1, iga_comp_nb_transi(1)
00672 IF (ila_comp_nb_transi_in(ib_ntt) .GT. 0) THEN
00673 ALLOCATE (sga_smioc_transi(ib_ntt)%sg_transi_in%sga_in_orig &
00674 (ila_comp_nb_transi_in(ib_ntt)), stat=id_err)
00675 IF (id_err > 0) THEN
00676 ierrp (1) = id_err
00677 ierrp (2) = ila_comp_nb_transi_in(ib_ntt)
00678 id_err = 13
00679
00680 call psmile_error ( id_err, 'sga_in_orig', &
00681 ierrp, 2, __FILE__, __LINE__ )
00682 RETURN
00683 ENDIF
00684 ELSE
00685 NULLIFY(sga_smioc_transi(ib_ntt)%sg_transi_in%sga_in_orig)
00686 ENDIF
00687 IF (ila_comp_nb_transi_out(ib_ntt) .GT. 0) THEN
00688 ALLOCATE (sga_smioc_transi(ib_ntt)%sga_transi_out &
00689 (ila_comp_nb_transi_out(ib_ntt)), stat=id_err)
00690 IF (id_err > 0) THEN
00691 ierrp (1) = id_err
00692 ierrp (2) = ila_comp_nb_transi_out(ib_ntt)
00693 id_err = 13
00694
00695 call psmile_error ( id_err, 'sga_transi_out', &
00696 ierrp, 2, __FILE__, __LINE__ )
00697 RETURN
00698 ENDIF
00699 ELSE
00700 NULLIFY(sga_smioc_transi(ib_ntt)%sga_transi_out)
00701 ENDIF
00702 IF (ila_comp_nb_stand_name(ib_ntt) .GT. 0) THEN
00703 ALLOCATE (sga_smioc_transi(ib_ntt)%cga_stand_name &
00704 (ila_comp_nb_stand_name(ib_ntt)), stat=id_err)
00705 IF (id_err > 0) THEN
00706 ierrp (1) = id_err
00707 ierrp (2) = ila_comp_nb_stand_name(ib_ntt)
00708 id_err = 13
00709
00710 call psmile_error ( id_err, 'cga_stand_name', &
00711 ierrp, 2, __FILE__, __LINE__ )
00712 RETURN
00713 ENDIF
00714 ELSE
00715 NULLIFY(sga_smioc_transi(ib_ntt)%cga_stand_name)
00716 ENDIF
00717 ENDDO
00718
00719
00720 CALL init_transi (iga_comp_nb_transi(1), &
00721 ila_comp_nb_stand_name, &
00722 ila_comp_nb_transi_in, &
00723 ila_comp_nb_transi_out, &
00724 sga_smioc_transi, &
00725 id_err )
00726 IF (id_err .ne. 0) WRITE(il_chanel,*) 'WARNING: Pb in init_transi'
00727
00728
00729 il_npartinid = 0
00730 il_npartoutid = 0
00731
00732
00733 #ifdef DEBUG
00734 WRITE(il_chanel,*) ' Get the transient for ', trim(cda_comp_name)
00735 call psmile_flushstd(il_chanel)
00736 #endif
00737
00738
00739
00740
00741 IF (Appl%stand_alone) THEN
00742 il_compid = 1
00743 ll_userdef_details = .false.
00744 CALL get_transi_details (iga_comp_id_doc_XML(1), &
00745 iga_comp_nb_transi(1), &
00746 sga_smioc_transi(:), &
00747 il_compid, &
00748 Appl%name, &
00749 cda_comp_name, &
00750 ll_userdef_details, &
00751 id_err )
00752 IF (id_err .ne. 0) &
00753 WRITE(il_chanel,*) 'WARNING: Pb in get_transi_details'
00754
00755
00756 DO ib_ntt = 1, iga_comp_nb_transi(1)
00757 DO ib_ntt2 = 1, iga_comp_nb_transi(1)
00758 DO ib_nin = 1, sga_smioc_transi(ib_ntt)%sg_transi_in%ig_nb_in_orig
00759 IF (sga_smioc_transi(ib_ntt)%sg_transi_in%sga_in_orig(ib_nin)% &
00760 cg_orig_comp_name .EQ. &
00761 sga_smioc_transi(ib_ntt2)%cg_comp_name) THEN
00762 sga_smioc_transi(ib_ntt)%sg_transi_in%sga_in_orig(ib_nin)%&
00763 ig_orig_comp_id = sga_smioc_transi(ib_ntt2)%ig_comp_id
00764 ENDIF
00765 ENDDO
00766 DO ib_nout = 1, sga_smioc_transi(ib_ntt)%ig_nb_transi_out
00767 IF (sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00768 cg_dest_comp_name .EQ. &
00769 sga_smioc_transi(ib_ntt2)%cg_comp_name) THEN
00770 sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00771 ig_dest_comp_id = sga_smioc_transi(ib_ntt2)%ig_comp_id
00772 ENDIF
00773 ENDDO
00774 ENDDO
00775 ENDDO
00776
00777
00778 DO ib_ntt2 = 1, iga_comp_nb_transi(1)
00779 il_combi = 1
00780 il_source = 1
00781 ll_combi = .false.
00782 ll_source = .false.
00783 DO ib_nin = 2, sga_smioc_transi(ib_ntt2)%sg_transi_in%ig_nb_in_orig
00784
00785 IF (sga_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00786 sg_combi%cg_combi_name .NE. ' ' .AND. &
00787 sga_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00788 sg_combi%cg_combi_name .EQ. sga_smioc_transi(ib_ntt2)% &
00789 sg_transi_in%sga_in_orig(ib_nin-1)%sg_combi%cg_combi_name) &
00790 il_combi = il_combi + 1
00791
00792
00793 IF (sga_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00794 cg_orig_comp_name .EQ. sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00795 sga_in_orig(ib_nin-1)%cg_orig_comp_name) &
00796 il_source = il_source + 1
00797 ENDDO
00798
00799 IF (sga_smioc_transi(ib_ntt2)%sg_transi_in%ig_nb_in_orig .GT. 1 .AND. &
00800 il_combi .EQ. sga_smioc_transi(ib_ntt2)%sg_transi_in%ig_nb_in_orig)&
00801 ll_combi = .TRUE.
00802
00803
00804 IF (sga_smioc_transi(ib_ntt2)%sg_transi_in%ig_nb_in_orig .GT. 1 .AND. &
00805 il_source .EQ. sga_smioc_transi(ib_ntt2)%sg_transi_in%ig_nb_in_orig) &
00806 ll_source = .TRUE.
00807 IF (ll_combi) THEN
00808 IF (ll_source) THEN
00809 sga_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(:)% &
00810 sg_combi%ig_location = PSMILe_source
00811 ELSE
00812 sga_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(:)% &
00813 sg_combi%ig_location = PSMILe_target
00814 ENDIF
00815 ENDIF
00816 ENDDO
00817
00818
00819
00820 DO ib_ntt = 1, iga_comp_nb_transi(1)
00821 DO ib_nout = 1, sga_smioc_transi(ib_ntt)%ig_nb_transi_out
00822 DO ib_ntt2 = 1, iga_comp_nb_transi(1)
00823 DO ib_nin = 1, sga_smioc_transi(ib_ntt2)%sg_transi_in%ig_nb_in_orig
00824 IF (sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00825 cg_transi_out_name &
00826 .EQ. sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00827 sga_in_orig(ib_nin)%cg_orig_transi .AND. &
00828 sga_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00829 cg_transi_in_name &
00830 .EQ. sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00831 cg_dest_transi) THEN
00832
00833 sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00834 ig_dest_transi_id = &
00835 sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00836 sga_in_orig(ib_nin)%ig_transi_in_id
00837 sga_smioc_transi(ib_ntt2)%sg_transi_in%sga_in_orig(ib_nin)% &
00838 ig_orig_transi_id = &
00839 sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00840 ig_transi_out_id
00841
00842 sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00843 sg_cpl_rst_file = &
00844 sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00845 sga_in_orig(ib_nin)%sg_cpl_rst_file
00846
00847 IF (sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00848 ig_dest_type .EQ. PSMILe_comp) &
00849 sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00850 sg_interp = &
00851 sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00852 sga_in_orig(ib_nin)%sg_interp
00853
00854 sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00855 ig_conserv = &
00856 sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00857 sga_in_orig(ib_nin)%ig_conserv
00858
00859 IF (sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00860 sga_in_orig(ib_nin)%sg_combi%ig_location &
00861 == PSMILe_source) &
00862 sga_smioc_transi(ib_ntt)%sga_transi_out(ib_nout)% &
00863 sg_combi = &
00864 sga_smioc_transi(ib_ntt2)%sg_transi_in% &
00865 sga_in_orig(ib_nin)%sg_combi
00866 ENDIF
00867 ENDDO
00868 ENDDO
00869 ENDDO
00870 ENDDO
00871
00872 ELSE
00873
00874 il_nb_int_i_fix = 27
00875 il_nb_int_i_in = 54
00876 il_nb_int_i_out = 82
00877
00878 il_smioc_recv_size_i = 0
00879 DO ib = 1, iga_comp_nb_transi(1)
00880 il_smioc_recv_size_i = il_smioc_recv_size_i &
00881 + il_nb_int_i_fix &
00882 + il_nb_int_i_in * ila_comp_nb_transi_in(ib) &
00883 + il_nb_int_i_out * ila_comp_nb_transi_out(ib)
00884 END DO
00885
00886 il_nb_int_d_fix = 6
00887 il_nb_int_d_in = 15
00888 il_nb_int_d_out = 19
00889
00890 il_smioc_recv_size_d = 0
00891 DO ib = 1, iga_comp_nb_transi(1)
00892 il_smioc_recv_size_d = il_smioc_recv_size_d &
00893 + il_nb_int_d_fix &
00894 + il_nb_int_d_in * ila_comp_nb_transi_in(ib) &
00895 + il_nb_int_d_out * ila_comp_nb_transi_out(ib)
00896 END DO
00897
00898 il_nb_int_c_fix = 4
00899 il_nb_int_c_in = 10
00900 il_nb_int_c_out = 9
00901
00902 il_smioc_recv_size_c = 0
00903 DO ib = 1, iga_comp_nb_transi(1)
00904 il_smioc_recv_size_c = il_smioc_recv_size_c &
00905 + il_nb_int_c_fix &
00906 + ila_comp_nb_stand_name(ib) &
00907 + il_nb_int_c_in * ila_comp_nb_transi_in(ib) &
00908 + il_nb_int_c_out * ila_comp_nb_transi_out(ib)
00909 END DO
00910
00911 ALLOCATE(ila_smioc_recv(il_smioc_recv_size_i), stat=id_err)
00912 IF (id_err > 0) THEN
00913 ierrp (1) = id_err
00914 ierrp (2) = il_smioc_recv_size_i
00915 id_err = 13
00916
00917 call psmile_error ( id_err, 'ila_smioc_recv', &
00918 ierrp, 2, __FILE__, __LINE__ )
00919 RETURN
00920 ENDIF
00921 ALLOCATE(cla_smioc_recv(il_smioc_recv_size_c), stat=id_err)
00922 IF (id_err > 0) THEN
00923 ierrp (1) = id_err
00924 ierrp (2) = il_smioc_recv_size_c
00925 id_err = 13
00926
00927 call psmile_error ( id_err, 'cla_smioc_recv', &
00928 ierrp, 2, __FILE__, __LINE__ )
00929 RETURN
00930 ENDIF
00931 ALLOCATE(dla_smioc_recv(il_smioc_recv_size_d), stat=id_err)
00932 IF (id_err > 0) THEN
00933 ierrp (1) = id_err
00934 ierrp (2) = il_smioc_recv_size_d
00935 id_err = 13
00936
00937 call psmile_error ( id_err, 'dla_smioc_recv', &
00938 ierrp, 2, __FILE__, __LINE__ )
00939 RETURN
00940 ENDIF
00941
00942 CALL MPI_Recv (ila_smioc_recv, il_smioc_recv_size_i, &
00943 MPI_Integer, PRISMdrv_root, 7, comm_trans, il_status, id_err )
00944
00945 CALL MPI_Recv (cla_smioc_recv, il_smioc_recv_size_c*max_name, &
00946 MPI_Character, PRISMdrv_root, 8, comm_trans, il_status, id_err )
00947
00948 CALL MPI_Recv (dla_smioc_recv, il_smioc_recv_size_d, &
00949 MPI_Double_Precision, PRISMdrv_root, 9, comm_trans, il_status, id_err )
00950
00951
00952 il_index_i = 0
00953 il_index_c = 0
00954 il_index_d = 0
00955
00956 DO ib = 1, iga_comp_nb_transi(1)
00957
00958
00959 sga_smioc_transi(ib)%ig_nb_stand_name = ila_smioc_recv(1 + il_index_i)
00960 sga_smioc_transi(ib)%ig_comp_id = ila_smioc_recv(2 + il_index_i)
00961 sga_smioc_transi(ib)%ig_transi_id = ila_smioc_recv(3 + il_index_i)
00962 sga_smioc_transi(ib)%ig_transi_type = ila_smioc_recv(4 + il_index_i)
00963 sga_smioc_transi(ib)%ig_nb_bndl = ila_smioc_recv(5 + il_index_i)
00964 sga_smioc_transi(ib)%ig_datatype = ila_smioc_recv(6 + il_index_i)
00965 sga_smioc_transi(ib)%ig_nb_transi_out = ila_smioc_recv(7 + il_index_i)
00966
00967
00968 sga_smioc_transi(ib)%sg_transi_in%ig_nb_in_orig = &
00969 ila_smioc_recv(8 + il_index_i)
00970 sga_smioc_transi(ib)%sg_transi_in%ig_exch_date_type = &
00971 ila_smioc_recv(9 + il_index_i)
00972 sga_smioc_transi(ib)%sg_transi_in%ig_debugmode = &
00973 ila_smioc_recv(10 + il_index_i)
00974 sga_smioc_transi(ib)%sg_transi_in%ig_tgt_timeop = &
00975 ila_smioc_recv(11 + il_index_i)
00976
00977 DO ib_ter = 1, 3
00978 sga_smioc_transi(ib)%sg_transi_in%iga_stats(ib_ter) = &
00979 ila_smioc_recv(11 + ib_ter + il_index_i)
00980 END DO
00981
00982
00983 sga_smioc_transi(ib)%sg_transi_in%sg_min_period%minute = &
00984 ila_smioc_recv(17 + il_index_i)
00985 sga_smioc_transi(ib)%sg_transi_in%sg_min_period%hour = &
00986 ila_smioc_recv(18 + il_index_i)
00987 sga_smioc_transi(ib)%sg_transi_in%sg_min_period%day = &
00988 ila_smioc_recv(19 + il_index_i)
00989 sga_smioc_transi(ib)%sg_transi_in%sg_min_period%month = &
00990 ila_smioc_recv(20 + il_index_i)
00991 sga_smioc_transi(ib)%sg_transi_in%sg_min_period%year = &
00992 ila_smioc_recv(21 + il_index_i)
00993
00994
00995 sga_smioc_transi(ib)%sg_transi_in%sg_tgt_local_trans%ig_gather = &
00996 ila_smioc_recv(22 + il_index_i)
00997
00998
00999 sga_smioc_transi(ib)%sg_transi_in%sg_exch_date%sg_period%minute = &
01000 ila_smioc_recv(23 + il_index_i)
01001 sga_smioc_transi(ib)%sg_transi_in%sg_exch_date%sg_period%hour = &
01002 ila_smioc_recv(24 + il_index_i)
01003 sga_smioc_transi(ib)%sg_transi_in%sg_exch_date%sg_period%day = &
01004 ila_smioc_recv(25 + il_index_i)
01005 sga_smioc_transi(ib)%sg_transi_in%sg_exch_date%sg_period%month = &
01006 ila_smioc_recv(26 + il_index_i)
01007 sga_smioc_transi(ib)%sg_transi_in%sg_exch_date%sg_period%year = &
01008 ila_smioc_recv(27 + il_index_i)
01009
01010 il_index_i = il_index_i + 27
01011
01012 DO ib_bis = 1, ila_comp_nb_transi_in(ib)
01013
01014
01015 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01016 ig_transi_in_id = ila_smioc_recv(1 + il_index_i)
01017 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01018 ig_orig_type = ila_smioc_recv(2 + il_index_i)
01019 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01020 ig_orig_transi_id = ila_smioc_recv(3 + il_index_i)
01021 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01022 ig_orig_comp_id = ila_smioc_recv(4 + il_index_i)
01023 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01024 ig_conserv = ila_smioc_recv(5 + il_index_i)
01025
01026
01027 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01028 sg_orig_file%ig_suffix = ila_smioc_recv(6 + il_index_i)
01029 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01030 sg_orig_file%ig_file_format = ila_smioc_recv(7 + il_index_i)
01031 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01032 sg_orig_file%ig_file_set = ila_smioc_recv(8 + il_index_i)
01033 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01034 sg_orig_file%ig_file_iomode = ila_smioc_recv(9 + il_index_i)
01035 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01036 sg_orig_file%ig_file_pack = ila_smioc_recv(10 + il_index_i)
01037
01038
01039 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01040 sg_cpl_rst_file%ig_suffix = ila_smioc_recv(11 + il_index_i)
01041 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01042 sg_cpl_rst_file%ig_file_format = ila_smioc_recv(12 + il_index_i)
01043 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01044 sg_cpl_rst_file%ig_file_set = ila_smioc_recv(13 + il_index_i)
01045 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01046 sg_cpl_rst_file%ig_file_iomode = ila_smioc_recv(14 + il_index_i)
01047 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01048 sg_cpl_rst_file%ig_file_pack = ila_smioc_recv(15 + il_index_i)
01049
01050
01051 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01052 sg_interp%ig_interp_type = ila_smioc_recv(16 + il_index_i)
01053 DO ib_ter = 1, 3
01054 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01055 sg_interp%iga_interp_meth(ib_ter) = &
01056 ila_smioc_recv(16 + ib_ter + il_index_i)
01057 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01058 sg_interp%iga_arg1(ib_ter) = &
01059 ila_smioc_recv(19 + ib_ter + il_index_i)
01060 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01061 sg_interp%iga_arg2(ib_ter) = &
01062 ila_smioc_recv(22 + ib_ter + il_index_i)
01063 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01064 sg_interp%iga_arg3(ib_ter) = &
01065 ila_smioc_recv(25 + ib_ter + il_index_i)
01066 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01067 sg_interp%iga_arg4(ib_ter) = &
01068 ila_smioc_recv(28 + ib_ter + il_index_i)
01069 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01070 sg_interp%iga_arg5(ib_ter) = &
01071 ila_smioc_recv(31 + ib_ter + il_index_i)
01072 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01073 sg_interp%iga_arg6(ib_ter) = &
01074 ila_smioc_recv(34 + ib_ter + il_index_i)
01075 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01076 sg_interp%iga_arg7(ib_ter) = &
01077 ila_smioc_recv(37 + ib_ter + il_index_i)
01078 END DO
01079
01080
01081 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01082 sg_interp%sg_arg10%ig_suffix = ila_smioc_recv(41 + il_index_i)
01083 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01084 sg_interp%sg_arg10%ig_file_format = ila_smioc_recv(42 + il_index_i)
01085 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01086 sg_interp%sg_arg10%ig_file_set = ila_smioc_recv(43 + il_index_i)
01087 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01088 sg_interp%sg_arg10%ig_file_iomode = &
01089 ila_smioc_recv(44 + il_index_i)
01090 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01091 sg_interp%sg_arg10%ig_file_pack = ila_smioc_recv(45 + il_index_i)
01092
01093
01094 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01095 sg_combi%sg_ext_mask_file%ig_suffix = &
01096 ila_smioc_recv(46 + il_index_i)
01097 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01098 sg_combi%sg_ext_mask_file%ig_file_format = &
01099 ila_smioc_recv(47 + il_index_i)
01100 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01101 sg_combi%sg_ext_mask_file%ig_file_set = &
01102 ila_smioc_recv(48 + il_index_i)
01103 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01104 sg_combi%sg_ext_mask_file%ig_file_iomode = &
01105 ila_smioc_recv(49 + il_index_i)
01106 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01107 sg_combi%sg_ext_mask_file%ig_file_pack = &
01108 ila_smioc_recv(50 + il_index_i)
01109 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01110 sg_combi%ig_location = ila_smioc_recv(51 + il_index_i)
01111 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01112 sg_combi%ig_operand = ila_smioc_recv(52 + il_index_i)
01113 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01114 sg_combi%ig_mask_type = ila_smioc_recv(53 + il_index_i)
01115 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01116 sg_combi%ig_combi_meth = ila_smioc_recv(54 + il_index_i)
01117
01118 il_index_i = il_index_i + 54
01119
01120 END DO
01121
01122 DO ib_bis = 1, ila_comp_nb_transi_out(ib)
01123
01124
01125 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01126 ig_transi_out_id = ila_smioc_recv(1 + il_index_i)
01127 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01128 ig_dest_type = ila_smioc_recv(2 + il_index_i)
01129 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01130 ig_dest_transi_id = ila_smioc_recv(3 + il_index_i)
01131 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01132 ig_dest_comp_id = ila_smioc_recv(4 + il_index_i)
01133 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01134 ig_exch_date_type = ila_smioc_recv(5 + il_index_i)
01135 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01136 ig_debugmode = ila_smioc_recv(6 + il_index_i)
01137 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01138 ig_lag = ila_smioc_recv(7 + il_index_i)
01139 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01140 ig_src_timeop = ila_smioc_recv(8 + il_index_i)
01141 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01142 ig_conserv = ila_smioc_recv(9 + il_index_i)
01143 DO ib_ter = 1, 3
01144 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01145 iga_stats(ib_ter) = ila_smioc_recv(9 + ib_ter + il_index_i)
01146 END DO
01147
01148
01149 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01150 sg_dest_file%ig_suffix = ila_smioc_recv(15 + il_index_i)
01151 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01152 sg_dest_file%ig_file_format = ila_smioc_recv(16 + il_index_i)
01153 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01154 sg_dest_file%ig_file_set = ila_smioc_recv(17 + il_index_i)
01155 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01156 sg_dest_file%ig_file_iomode = ila_smioc_recv(18 + il_index_i)
01157 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01158 sg_dest_file%ig_file_pack = ila_smioc_recv(19 + il_index_i)
01159
01160
01161 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01162 sg_cpl_rst_file%ig_suffix = ila_smioc_recv(20 + il_index_i)
01163 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01164 sg_cpl_rst_file%ig_file_format = ila_smioc_recv(21 + il_index_i)
01165 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01166 sg_cpl_rst_file%ig_file_set = ila_smioc_recv(22 + il_index_i)
01167 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01168 sg_cpl_rst_file%ig_file_iomode = ila_smioc_recv(23 + il_index_i)
01169 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01170 sg_cpl_rst_file%ig_file_pack = ila_smioc_recv(24 + il_index_i)
01171
01172
01173 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01174 sg_min_period%minute = ila_smioc_recv(25 + il_index_i)
01175 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01176 sg_min_period%hour = ila_smioc_recv(26 + il_index_i)
01177 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01178 sg_min_period%day = ila_smioc_recv(27 + il_index_i)
01179 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01180 sg_min_period%month = ila_smioc_recv(28 + il_index_i)
01181 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01182 sg_min_period%year = ila_smioc_recv(29 + il_index_i)
01183
01184
01185 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01186 sg_exch_date%sg_period%minute = ila_smioc_recv(30 + il_index_i)
01187 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01188 sg_exch_date%sg_period%hour = ila_smioc_recv(31 + il_index_i)
01189 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01190 sg_exch_date%sg_period%day = ila_smioc_recv(32 + il_index_i)
01191 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01192 sg_exch_date%sg_period%month = ila_smioc_recv(33 + il_index_i)
01193 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01194 sg_exch_date%sg_period%year = ila_smioc_recv(34 + il_index_i)
01195
01196
01197 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01198 sg_src_local_trans%ig_scatter = ila_smioc_recv(35 + il_index_i)
01199 DO ib_ter = 1, 4
01200 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01201 sg_src_local_trans%ig_reduc_type(ib_ter) = &
01202 ila_smioc_recv(35 + ib_ter + il_index_i)
01203 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01204 sg_src_local_trans%ig_reduc_order(ib_ter) = &
01205 ila_smioc_recv(39 + ib_ter + il_index_i)
01206 END DO
01207
01208
01209 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01210 sg_interp%ig_interp_type = ila_smioc_recv(44 + il_index_i)
01211 DO ib_ter = 1, 3
01212 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01213 sg_interp%iga_interp_meth(ib_ter) = &
01214 ila_smioc_recv(44 + ib_ter + il_index_i)
01215 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01216 sg_interp%iga_arg1(ib_ter) = &
01217 ila_smioc_recv(47 + ib_ter + il_index_i)
01218 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01219 sg_interp%iga_arg2(ib_ter) = &
01220 ila_smioc_recv(50 + ib_ter + il_index_i)
01221 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01222 sg_interp%iga_arg3(ib_ter) = &
01223 ila_smioc_recv(53 + ib_ter + il_index_i)
01224 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01225 sg_interp%iga_arg4(ib_ter) = &
01226 ila_smioc_recv(56 + ib_ter + il_index_i)
01227 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01228 sg_interp%iga_arg5(ib_ter) = &
01229 ila_smioc_recv(59 + ib_ter + il_index_i)
01230 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01231 sg_interp%iga_arg6(ib_ter) = &
01232 ila_smioc_recv(62 + ib_ter + il_index_i)
01233 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01234 sg_interp%iga_arg7(ib_ter) = &
01235 ila_smioc_recv(65 + ib_ter + il_index_i)
01236 END DO
01237
01238
01239 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01240 sg_interp%sg_arg10%ig_suffix = ila_smioc_recv(69 + il_index_i)
01241 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01242 sg_interp%sg_arg10%ig_file_format = ila_smioc_recv(70 + il_index_i)
01243 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01244 sg_interp%sg_arg10%ig_file_set = ila_smioc_recv(71 + il_index_i)
01245 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01246 sg_interp%sg_arg10%ig_file_iomode = &
01247 ila_smioc_recv(72 + il_index_i)
01248 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01249 sg_interp%sg_arg10%ig_file_pack = ila_smioc_recv(73 + il_index_i)
01250
01251
01252 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01253 sg_combi%sg_ext_mask_file%ig_suffix = &
01254 ila_smioc_recv(74 + il_index_i)
01255 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01256 sg_combi%sg_ext_mask_file%ig_file_format = &
01257 ila_smioc_recv(75 + il_index_i)
01258 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01259 sg_combi%sg_ext_mask_file%ig_file_set = &
01260 ila_smioc_recv(76 + il_index_i)
01261 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01262 sg_combi%sg_ext_mask_file%ig_file_iomode = &
01263 ila_smioc_recv(77 + il_index_i)
01264 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01265 sg_combi%sg_ext_mask_file%ig_file_pack = &
01266 ila_smioc_recv(78 + il_index_i)
01267 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01268 sg_combi%ig_location = ila_smioc_recv(79 + il_index_i)
01269 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01270 sg_combi%ig_operand = ila_smioc_recv(80 + il_index_i)
01271 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01272 sg_combi%ig_mask_type = ila_smioc_recv(81 + il_index_i)
01273 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01274 sg_combi%ig_combi_meth = ila_smioc_recv(82 + il_index_i)
01275
01276 il_index_i = il_index_i + 82
01277
01278 END DO
01279
01280 sga_smioc_transi(ib)%cg_local_name = trim(cla_smioc_recv(1 + il_index_c))
01281 sga_smioc_transi(ib)%cg_long_name = trim(cla_smioc_recv(2 + il_index_c))
01282 sga_smioc_transi(ib)%cg_comp_name = trim(cla_smioc_recv(3 + il_index_c))
01283 sga_smioc_transi(ib)%cg_units = trim(cla_smioc_recv(4 + il_index_c))
01284 il_index_c = il_index_c + 4
01285
01286 DO ib_bis = 1, ila_comp_nb_stand_name(ib)
01287
01288 sga_smioc_transi(ib)%cga_stand_name(ib_bis) = &
01289 cla_smioc_recv(1 + il_index_c)
01290
01291 il_index_c = il_index_c + 1
01292
01293 END DO
01294
01295 DO ib_bis = 1, ila_comp_nb_transi_in(ib)
01296
01297 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01298 cg_transi_in_name = cla_smioc_recv(1 + il_index_c)
01299 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01300 cg_orig_transi = cla_smioc_recv(2 + il_index_c)
01301 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01302 cg_orig_comp_name = cla_smioc_recv(3 + il_index_c)
01303 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01304 sg_orig_file%cg_file_name = cla_smioc_recv(4 + il_index_c)
01305 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01306 sg_cpl_rst_file%cg_file_name = cla_smioc_recv(5 + il_index_c)
01307 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01308 sg_interp%cg_arg9 = cla_smioc_recv(6 + il_index_c)
01309 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01310 sg_interp%sg_arg10%cg_file_name = cla_smioc_recv(7 + il_index_c)
01311 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01312 sg_combi%cg_combi_name = cla_smioc_recv(8 + il_index_c)
01313 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01314 sg_combi%cg_ext_mask_name = cla_smioc_recv(9 + il_index_c)
01315 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01316 sg_combi%sg_ext_mask_file%cg_file_name = &
01317 cla_smioc_recv(10 + il_index_c)
01318
01319 il_index_c = il_index_c + 10
01320
01321 END DO
01322
01323 DO ib_bis = 1, ila_comp_nb_transi_out(ib)
01324
01325 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01326 cg_transi_out_name = cla_smioc_recv(1 + il_index_c)
01327 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01328 cg_dest_transi = cla_smioc_recv(2 + il_index_c)
01329 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01330 cg_dest_comp_name = cla_smioc_recv(3 + il_index_c)
01331 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01332 sg_dest_file%cg_file_name = cla_smioc_recv(4 + il_index_c)
01333 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01334 sg_cpl_rst_file%cg_file_name = cla_smioc_recv(5 + il_index_c)
01335 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01336 sg_interp%cg_arg9 = cla_smioc_recv(6 + il_index_c)
01337 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01338 sg_interp%sg_arg10%cg_file_name = cla_smioc_recv(7 + il_index_c)
01339 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01340 sg_combi%cg_ext_mask_name = cla_smioc_recv(8 + il_index_c)
01341 sga_smioc_transi(ib)%sga_transi_out(ib_bis)% &
01342 sg_combi%sg_ext_mask_file%cg_file_name = &
01343 cla_smioc_recv(9 + il_index_c)
01344
01345 il_index_c = il_index_c + 9
01346
01347 END DO
01348
01349 sga_smioc_transi(ib)%dg_transi_min = dla_smioc_recv(1 + il_index_d)
01350 sga_smioc_transi(ib)%dg_transi_max = dla_smioc_recv(2 + il_index_d)
01351 sga_smioc_transi(ib)%sg_transi_in%sg_min_period%second = &
01352 dla_smioc_recv(3 + il_index_d)
01353 sga_smioc_transi(ib)%sg_transi_in%sg_tgt_local_trans%dg_add_scalar = &
01354 dla_smioc_recv(4 + il_index_d)
01355 sga_smioc_transi(ib)%sg_transi_in%sg_tgt_local_trans%dg_mult_scalar = &
01356 dla_smioc_recv(5 + il_index_d)
01357 sga_smioc_transi(ib)%sg_transi_in%sg_exch_date%sg_period%second = &
01358 dla_smioc_recv(6 + il_index_d)
01359
01360 il_index_d = il_index_d + 6
01361
01362 DO ib_bis = 1, ila_comp_nb_transi_in(ib)
01363
01364 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01365 sg_orig_file%dg_file_scal = dla_smioc_recv(1 + il_index_d)
01366 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01367 sg_orig_file%dg_file_add = dla_smioc_recv(2 + il_index_d)
01368 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01369 sg_orig_file%dg_fill_val = dla_smioc_recv(3 + il_index_d)
01370 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01371 sg_cpl_rst_file%dg_file_scal = dla_smioc_recv(4 + il_index_d)
01372 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01373 sg_cpl_rst_file%dg_file_add = dla_smioc_recv(5 + il_index_d)
01374 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01375 sg_cpl_rst_file%dg_file_scal = dla_smioc_recv(6 + il_index_d)
01376 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01377 sg_interp%dg_arg8 = dla_smioc_recv(7 + il_index_d)
01378 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01379 sg_interp%sg_arg10%dg_file_scal = dla_smioc_recv(8 + il_index_d)
01380 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01381 sg_interp%sg_arg10%dg_file_add = dla_smioc_recv(9 + il_index_d)
01382 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01383 sg_interp%sg_arg10%dg_fill_val = dla_smioc_recv(10 + il_index_d)
01384 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01385 sg_combi%sg_ext_mask_file%dg_file_scal = &
01386 dla_smioc_recv(11 + il_index_d)
01387 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01388 sg_combi%sg_ext_mask_file%dg_file_add = &
01389 dla_smioc_recv(12 + il_index_d)
01390 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01391 sg_combi%sg_ext_mask_file%dg_fill_val = &
01392 dla_smioc_recv(13 + il_index_d)
01393 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01394 sg_combi%dg_combi_param = dla_smioc_recv(14 + il_index_d)
01395 sga_smioc_transi(ib)%sg_transi_in%sga_in_orig(ib_bis)% &
01396 sg_combi%dg_scalar = dla_smioc_recv(15 + il_index_d)
01397
01398 il_index_d = il_index_d + 15
01399
01400 END DO
01401
01402 DO ib_bis = 1, ila_comp_nb_transi_out(ib)
01403
01404 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_dest_file% &
01405 dg_file_scal = dla_smioc_recv(1 + il_index_d)
01406 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_dest_file% &
01407 dg_file_add = dla_smioc_recv(2 + il_index_d)
01408 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_dest_file% &
01409 dg_fill_val = dla_smioc_recv(3 + il_index_d)
01410 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_cpl_rst_file% &
01411 dg_file_scal = dla_smioc_recv(4 + il_index_d)
01412 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_cpl_rst_file% &
01413 dg_file_add = dla_smioc_recv(5 + il_index_d)
01414 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_cpl_rst_file% &
01415 dg_fill_val = dla_smioc_recv(6 + il_index_d)
01416 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_min_period%second = &
01417 dla_smioc_recv(7 + il_index_d)
01418 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_exch_date% &
01419 sg_period%second = dla_smioc_recv(8 + il_index_d)
01420 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_src_local_trans% &
01421 dg_add_scalar = dla_smioc_recv(9 + il_index_d)
01422 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_src_local_trans% &
01423 dg_mult_scalar = dla_smioc_recv(10 + il_index_d)
01424 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_interp%dg_arg8 = &
01425 dla_smioc_recv(11 + il_index_d)
01426 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_interp% &
01427 sg_arg10%dg_file_scal = dla_smioc_recv(12 + il_index_d)
01428 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_interp% &
01429 sg_arg10%dg_file_add = dla_smioc_recv(13 + il_index_d)
01430 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_interp% &
01431 sg_arg10%dg_fill_val = dla_smioc_recv(14 + il_index_d)
01432 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_combi% &
01433 sg_ext_mask_file%dg_file_scal = dla_smioc_recv(15 + il_index_d)
01434 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_combi% &
01435 sg_ext_mask_file%dg_file_add = dla_smioc_recv(16 + il_index_d)
01436 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_combi% &
01437 sg_ext_mask_file%dg_fill_val = dla_smioc_recv(17 + il_index_d)
01438 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_combi% &
01439 dg_combi_param = dla_smioc_recv(17 + il_index_d)
01440 sga_smioc_transi(ib)%sga_transi_out(ib_bis)%sg_combi% &
01441 dg_scalar = dla_smioc_recv(17 + il_index_d)
01442
01443 il_index_d = il_index_d + 19
01444 END DO
01445 END DO
01446
01447 DEALLOCATE(ila_smioc_recv, stat=id_err)
01448 IF (id_err > 0) THEN
01449 ierrp (1) = id_err
01450 id_err = 14
01451
01452 call psmile_error ( id_err, 'ila_smioc_recv', &
01453 ierrp, 1, __FILE__, __LINE__ )
01454 RETURN
01455 ENDIF
01456 DEALLOCATE(cla_smioc_recv, stat=id_err)
01457 IF (id_err > 0) THEN
01458 ierrp (1) = id_err
01459 id_err = 14
01460
01461 call psmile_error ( id_err, 'cla_smioc_recv', &
01462 ierrp, 1, __FILE__, __LINE__ )
01463 RETURN
01464 ENDIF
01465 DEALLOCATE(dla_smioc_recv, stat=id_err)
01466 IF (id_err > 0) THEN
01467 ierrp (1) = id_err
01468 id_err = 14
01469
01470 call psmile_error ( id_err, 'dla_smioc_recv', &
01471 ierrp, 1, __FILE__, __LINE__ )
01472 RETURN
01473 ENDIF
01474
01475
01476
01477 CALL MPI_Recv (ila_dim_size, 7, MPI_Integer, PRISMdrv_root, 11, &
01478 comm_trans, il_status, id_err)
01479
01480
01481 IF (ila_dim_size(1) .gt. 0) THEN
01482
01483 ALLOCATE(ila_orig_comp_id(ila_dim_size(1),3), stat = id_err)
01484 IF (id_err > 0) THEN
01485 ierrp (1) = id_err
01486 ierrp (2) = ila_dim_size(1)*3
01487 id_err = 13
01488
01489 call psmile_error ( id_err, 'ila_orig_comp_id', &
01490 ierrp, 2, __FILE__, __LINE__ )
01491 RETURN
01492 ENDIF
01493
01494 CALL MPI_Recv (ila_orig_comp_id, ila_dim_size(1)*3, MPI_Integer, &
01495 PRISMdrv_root, 12, comm_trans, il_status, id_err)
01496
01497 DO ib = 1, ila_dim_size(1)
01498 DO ib_transi = 1, iga_comp_nb_transi(1)
01499 IF (sga_smioc_transi(ib_transi)%ig_transi_id == &
01500 ila_orig_comp_id(ib,1)) THEN
01501 sga_smioc_transi(ib_transi)%sg_transi_in% &
01502 sga_in_orig(ila_orig_comp_id(ib,2))%ig_orig_comp_id = &
01503 ila_orig_comp_id(ib,3)
01504 EXIT
01505 END IF
01506 END DO
01507 END DO
01508
01509 DEALLOCATE(ila_orig_comp_id, stat=id_err)
01510 IF (id_err > 0) THEN
01511 ierrp (1) = id_err
01512 id_err = 14
01513
01514 call psmile_error ( id_err, 'ila_orig_comp_id', &
01515 ierrp, 1, __FILE__, __LINE__ )
01516 RETURN
01517 ENDIF
01518
01519 END IF
01520
01521
01522 IF (ila_dim_size(2) .gt. 0) THEN
01523
01524 ALLOCATE(ila_dest_comp_id(ila_dim_size(2),3), stat = id_err)
01525 IF (id_err > 0) THEN
01526 ierrp (1) = id_err
01527 ierrp (2) = ila_dim_size(2)*3
01528 id_err = 13
01529
01530 call psmile_error ( id_err, 'ila_dest_comp_id', &
01531 ierrp, 2, __FILE__, __LINE__ )
01532 RETURN
01533 ENDIF
01534
01535 CALL MPI_Recv (ila_dest_comp_id, ila_dim_size(2)*3, MPI_Integer, &
01536 PRISMdrv_root, 13, comm_trans, il_status, id_err)
01537
01538 DO ib = 1, ila_dim_size(2)
01539 DO ib_transi = 1, iga_comp_nb_transi(1)
01540 IF (sga_smioc_transi(ib_transi)%ig_transi_id == &
01541 ila_dest_comp_id(ib,1)) THEN
01542 sga_smioc_transi(ib_transi)% &
01543 sga_transi_out(ila_dest_comp_id(ib,2))%ig_dest_comp_id = &
01544 ila_dest_comp_id(ib,3)
01545 EXIT
01546 END IF
01547 END DO
01548 END DO
01549
01550 DEALLOCATE(ila_dest_comp_id, stat=id_err)
01551 IF (id_err > 0) THEN
01552 ierrp (1) = id_err
01553 id_err = 14
01554
01555 call psmile_error ( id_err, 'ila_dest_comp_id', &
01556 ierrp, 1, __FILE__, __LINE__ )
01557 RETURN
01558 ENDIF
01559
01560 END IF
01561
01562
01563 IF (ila_dim_size(3) .gt. 0) THEN
01564
01565 ALLOCATE(ila_combi_loc(ila_dim_size(3),2), stat = id_err)
01566 IF (id_err > 0) THEN
01567 ierrp (1) = id_err
01568 ierrp (2) = ila_dim_size(3)*2
01569 id_err = 13
01570
01571 call psmile_error ( id_err, 'ila_combi_loc', &
01572 ierrp, 2, __FILE__, __LINE__ )
01573 RETURN
01574 ENDIF
01575
01576 CALL MPI_Recv (ila_combi_loc, ila_dim_size(3)*2, MPI_Integer, &
01577 PRISMdrv_root, 14, comm_trans, il_status, id_err)
01578
01579 DO ib = 1, ila_dim_size(3)
01580 DO ib_transi = 1, iga_comp_nb_transi(1)
01581 IF (sga_smioc_transi(ib_transi)%ig_transi_id == &
01582 ila_combi_loc(ib,1)) THEN
01583 sga_smioc_transi(ib_transi)% &
01584 sg_transi_in%sga_in_orig(:)%sg_combi%ig_location = &
01585 ila_combi_loc(ib,2)
01586 EXIT
01587 END IF
01588 END DO
01589 END DO
01590
01591 DEALLOCATE(ila_combi_loc, stat=id_err)
01592 IF (id_err > 0) THEN
01593 ierrp (1) = id_err
01594 id_err = 14
01595
01596 call psmile_error ( id_err, 'ila_combi_loc', &
01597 ierrp, 1, __FILE__, __LINE__ )
01598 RETURN
01599 ENDIF
01600
01601 END IF
01602
01603
01604 IF (ila_dim_size(4) .gt. 0) THEN
01605
01606 ALLOCATE(ila_trans_orig_id(ila_dim_size(4),3), stat = id_err)
01607 IF (id_err > 0) THEN
01608 ierrp (1) = id_err
01609 ierrp (2) = ila_dim_size(4)*3
01610 id_err = 13
01611
01612 call psmile_error ( id_err, 'ila_trans_orig_id', &
01613 ierrp, 2, __FILE__, __LINE__ )
01614 RETURN
01615 ENDIF
01616
01617 CALL MPI_Recv (ila_trans_orig_id, ila_dim_size(4)*3, MPI_Integer, &
01618 PRISMdrv_root, 15, comm_trans, il_status, id_err)
01619
01620 DO ib = 1, ila_dim_size(4)
01621 DO ib_transi = 1, iga_comp_nb_transi(1)
01622 IF (sga_smioc_transi(ib_transi)%ig_transi_id == &
01623 ila_trans_orig_id(ib,1)) THEN
01624 sga_smioc_transi(ib_transi)% &
01625 sg_transi_in%sga_in_orig(ila_trans_orig_id(ib,2))% &
01626 ig_orig_transi_id = ila_trans_orig_id(ib,3)
01627 EXIT
01628 END IF
01629 END DO
01630 END DO
01631
01632 DEALLOCATE(ila_trans_orig_id, stat=id_err)
01633 IF (id_err > 0) THEN
01634 ierrp (1) = id_err
01635 id_err = 14
01636
01637 call psmile_error ( id_err, 'ila_trans_orig_id', &
01638 ierrp, 1, __FILE__, __LINE__ )
01639 RETURN
01640 ENDIF
01641
01642 END IF
01643
01644
01645 IF (ila_dim_size(5) .gt. 0) THEN
01646
01647 ALLOCATE(ila_trans_dest_id(ila_dim_size(5),3), stat = id_err)
01648 IF (id_err > 0) THEN
01649 ierrp (1) = id_err
01650 ierrp (2) = ila_dim_size(5)*3
01651 id_err = 13
01652
01653 call psmile_error ( id_err, 'ila_trans_dest_id', &
01654 ierrp, 2, __FILE__, __LINE__ )
01655 RETURN
01656 ENDIF
01657
01658 CALL MPI_Recv (ila_trans_dest_id, ila_dim_size(5)*3, MPI_Integer, &
01659 PRISMdrv_root, 16, comm_trans, il_status, id_err)
01660
01661 DO ib = 1, ila_dim_size(5)
01662 DO ib_transi = 1, iga_comp_nb_transi(1)
01663 IF (sga_smioc_transi(ib_transi)%ig_transi_id == &
01664 ila_trans_dest_id(ib,1)) THEN
01665 sga_smioc_transi(ib_transi)% &
01666 sga_transi_out(ila_trans_dest_id(ib,2))% &
01667 ig_dest_transi_id = ila_trans_dest_id(ib,3)
01668 EXIT
01669 END IF
01670 END DO
01671 END DO
01672
01673 DEALLOCATE(ila_trans_dest_id, stat=id_err)
01674 IF (id_err > 0) THEN
01675 ierrp (1) = id_err
01676 id_err = 14
01677
01678 call psmile_error ( id_err, 'ila_trans_dest_id', &
01679 ierrp, 1, __FILE__, __LINE__ )
01680 RETURN
01681 ENDIF
01682
01683 END IF
01684
01685
01686 IF (ila_dim_size(6) .gt. 0) THEN
01687
01688 ALLOCATE(ila_cpl_rst_file(ila_dim_size(6),8), stat = id_err)
01689 IF (id_err > 0) THEN
01690 ierrp (1) = id_err
01691 ierrp (2) = ila_dim_size(6)
01692 id_err = 13
01693
01694 call psmile_error ( id_err, 'ila_cpl_rst_file', &
01695 ierrp, 2, __FILE__, __LINE__ )
01696 RETURN
01697 ENDIF
01698 ALLOCATE(dla_cpl_rst_file(ila_dim_size(6),3), stat = id_err)
01699 IF (id_err > 0) THEN
01700 ierrp (1) = id_err
01701 ierrp (2) = ila_dim_size(6)
01702 id_err = 13
01703
01704 call psmile_error ( id_err, 'dla_cpl_rst_file', &
01705 ierrp, 2, __FILE__, __LINE__ )
01706 RETURN
01707 ENDIF
01708 ALLOCATE(cla_cpl_rst_file(ila_dim_size(6),1), stat = id_err)
01709 IF (id_err > 0) THEN
01710 ierrp (1) = id_err
01711 ierrp (2) = ila_dim_size(6)
01712 id_err = 13
01713
01714 call psmile_error ( id_err, 'cla_cpl_rst_file', &
01715 ierrp, 2, __FILE__, __LINE__ )
01716 RETURN
01717 ENDIF
01718
01719 CALL MPI_Recv (ila_cpl_rst_file, ila_dim_size(6)*8, MPI_Integer, &
01720 PRISMdrv_root, 17, comm_trans, il_status, id_err)
01721
01722 CALL MPI_Recv (dla_cpl_rst_file, ila_dim_size(6)*3, &
01723 MPI_Double_Precision, PRISMdrv_root, 18, comm_trans, il_status,id_err)
01724
01725 CALL MPI_Recv (cla_cpl_rst_file, ila_dim_size(6)*max_name, &
01726 MPI_Character, PRISMdrv_root, 19, comm_trans, il_status, id_err)
01727
01728 DO ib = 1, ila_dim_size(6)
01729 DO ib_transi = 1, iga_comp_nb_transi(1)
01730 IF (sga_smioc_transi(ib_transi)%ig_transi_id == &
01731 ila_cpl_rst_file(ib,1)) THEN
01732
01733 sga_smioc_transi(ib_transi)% &
01734 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01735 sg_cpl_rst_file%ig_suffix = ila_cpl_rst_file(ib,3)
01736 sga_smioc_transi(ib_transi)% &
01737 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01738 sg_cpl_rst_file%ig_file_format = ila_cpl_rst_file(ib,4)
01739 sga_smioc_transi(ib_transi)% &
01740 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01741 sg_cpl_rst_file%ig_file_set = ila_cpl_rst_file(ib,5)
01742 sga_smioc_transi(ib_transi)% &
01743 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01744 sg_cpl_rst_file%ig_file_iomode = ila_cpl_rst_file(ib,6)
01745 sga_smioc_transi(ib_transi)% &
01746 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01747 sg_cpl_rst_file%ig_file_pack = ila_cpl_rst_file(ib,7)
01748
01749 sga_smioc_transi(ib_transi)% &
01750 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01751 sg_cpl_rst_file%dg_file_scal = dla_cpl_rst_file(ib,1)
01752 sga_smioc_transi(ib_transi)% &
01753 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01754 sg_cpl_rst_file%dg_file_add = dla_cpl_rst_file(ib,2)
01755 sga_smioc_transi(ib_transi)% &
01756 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01757 sg_cpl_rst_file%dg_fill_val = dla_cpl_rst_file(ib,3)
01758
01759 sga_smioc_transi(ib_transi)% &
01760 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01761 sg_cpl_rst_file%cg_file_name = cla_cpl_rst_file(ib,1)
01762
01763 sga_smioc_transi(ib_transi)% &
01764 sga_transi_out(ila_cpl_rst_file(ib,2))% &
01765 ig_conserv = ila_cpl_rst_file(ib,8)
01766
01767 EXIT
01768 END IF
01769 END DO
01770 END DO
01771
01772 DEALLOCATE(ila_cpl_rst_file, stat=id_err)
01773 DEALLOCATE(dla_cpl_rst_file, stat=id_err)
01774 DEALLOCATE(cla_cpl_rst_file, stat=id_err)
01775 IF (id_err > 0) THEN
01776 ierrp (1) = id_err
01777 id_err = 14
01778
01779 call psmile_error ( id_err, 'cpl_rst_file', &
01780 ierrp, 1, __FILE__, __LINE__ )
01781 RETURN
01782 ENDIF
01783
01784 END IF
01785
01786
01787 IF (ila_dim_size(7) .gt. 0) THEN
01788
01789 ALLOCATE(ila_trans_interp(ila_dim_size(7),32), stat = id_err)
01790 IF (id_err > 0) THEN
01791 ierrp (1) = id_err
01792 ierrp (2) = ila_dim_size(7)
01793 id_err = 13
01794
01795 call psmile_error ( id_err, 'ila_trans_interp', &
01796 ierrp, 2, __FILE__, __LINE__ )
01797 RETURN
01798 ENDIF
01799 ALLOCATE(dla_trans_interp(ila_dim_size(7),4), stat = id_err)
01800 IF (id_err > 0) THEN
01801 ierrp (1) = id_err
01802 ierrp (2) = ila_dim_size(7)
01803 id_err = 13
01804
01805 call psmile_error ( id_err, 'dla_trans_interp', &
01806 ierrp, 2, __FILE__, __LINE__ )
01807 RETURN
01808 ENDIF
01809 ALLOCATE(cla_trans_interp(ila_dim_size(7),2), stat = id_err)
01810 IF (id_err > 0) THEN
01811 ierrp (1) = id_err
01812 ierrp (2) = ila_dim_size(7)
01813 id_err = 13
01814
01815 call psmile_error ( id_err, 'cla_trans_interp', &
01816 ierrp, 2, __FILE__, __LINE__ )
01817 RETURN
01818 ENDIF
01819
01820 CALL MPI_Recv (ila_trans_interp, ila_dim_size(7)*32, MPI_Integer, &
01821 PRISMdrv_root, 20, comm_trans, il_status, id_err)
01822
01823 CALL MPI_Recv (dla_trans_interp, ila_dim_size(7)*4, &
01824 MPI_Double_Precision, PRISMdrv_root, 21, comm_trans, &
01825 il_status, id_err)
01826
01827 CALL MPI_Recv (cla_trans_interp, ila_dim_size(7)*max_name*2, &
01828 MPI_Character, PRISMdrv_root, 22, comm_trans, il_status, id_err)
01829
01830 DO ib = 1, ila_dim_size(7)
01831 DO ib_transi = 1, iga_comp_nb_transi(1)
01832 IF (sga_smioc_transi(ib_transi)%ig_transi_id == &
01833 ila_trans_interp(ib,1)) THEN
01834
01835 sga_smioc_transi(ib_transi)% &
01836 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01837 ig_interp_type = ila_trans_interp(ib,3)
01838 sga_smioc_transi(ib_transi)% &
01839 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01840 iga_arg1 = ila_trans_interp(ib,4:6)
01841 sga_smioc_transi(ib_transi)% &
01842 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01843 iga_arg2 = ila_trans_interp(ib,7:9)
01844 sga_smioc_transi(ib_transi)% &
01845 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01846 iga_arg3 = ila_trans_interp(ib,10:12)
01847 sga_smioc_transi(ib_transi)% &
01848 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01849 iga_arg4 = ila_trans_interp(ib,13:15)
01850 sga_smioc_transi(ib_transi)% &
01851 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01852 iga_arg5 = ila_trans_interp(ib,16:18)
01853 sga_smioc_transi(ib_transi)% &
01854 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01855 iga_arg6 = ila_trans_interp(ib,19:21)
01856 sga_smioc_transi(ib_transi)% &
01857 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01858 iga_arg7 = ila_trans_interp(ib,22:24)
01859 sga_smioc_transi(ib_transi)% &
01860 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01861 iga_interp_meth = ila_trans_interp(ib,25:27)
01862
01863 sga_smioc_transi(ib_transi)% &
01864 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01865 sg_arg10%ig_suffix = ila_trans_interp(ib,28)
01866 sga_smioc_transi(ib_transi)% &
01867 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01868 sg_arg10%ig_file_format = ila_trans_interp(ib,29)
01869 sga_smioc_transi(ib_transi)% &
01870 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01871 sg_arg10%ig_file_set = ila_trans_interp(ib,30)
01872 sga_smioc_transi(ib_transi)% &
01873 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01874 sg_arg10%ig_file_iomode = ila_trans_interp(ib,31)
01875 sga_smioc_transi(ib_transi)% &
01876 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01877 sg_arg10%ig_file_pack = ila_trans_interp(ib,32)
01878
01879 sga_smioc_transi(ib_transi)% &
01880 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01881 dg_arg8 = dla_trans_interp(ib,1)
01882 sga_smioc_transi(ib_transi)% &
01883 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01884 sg_arg10%dg_file_scal = dla_trans_interp(ib,2)
01885 sga_smioc_transi(ib_transi)% &
01886 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01887 sg_arg10%dg_file_add = dla_trans_interp(ib,3)
01888 sga_smioc_transi(ib_transi)% &
01889 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01890 sg_arg10%dg_fill_val = dla_trans_interp(ib,4)
01891
01892
01893 sga_smioc_transi(ib_transi)% &
01894 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01895 cg_arg9 = cla_trans_interp(ib,1)
01896
01897 sga_smioc_transi(ib_transi)% &
01898 sga_transi_out(ila_trans_interp(ib,2))%sg_interp% &
01899 sg_arg10%cg_file_name = cla_trans_interp(ib,2)
01900
01901 EXIT
01902 END IF
01903 END DO
01904 END DO
01905
01906 DEALLOCATE(ila_trans_interp, stat=id_err)
01907 DEALLOCATE(dla_trans_interp, stat=id_err)
01908 DEALLOCATE(cla_trans_interp, stat=id_err)
01909 IF (id_err > 0) THEN
01910 ierrp (1) = id_err
01911 id_err = 14
01912
01913 call psmile_error ( id_err, 'trans_interp', &
01914 ierrp, 1, __FILE__, __LINE__ )
01915 RETURN
01916 ENDIF
01917
01918 END IF
01919
01920 END IF
01921
01922 DEALLOCATE(ila_comp_nb_stand_name)
01923 DEALLOCATE(ila_comp_nb_transi_in)
01924 DEALLOCATE(ila_comp_nb_transi_out)
01925
01926 END IF
01927
01928 #ifdef DEBUG
01929 WRITE(il_chanel,*) ' '
01930 WRITE(il_chanel,*) ' ila_dim_size ', ila_dim_size
01931 WRITE(il_chanel,*) ' '
01932 WRITE(il_chanel,*) ' Got transient details '
01933 call psmile_flushstd(il_chanel)
01934 #endif
01935
01936
01937
01938
01939
01940 #ifdef DEBUG
01941
01942
01943
01944
01945
01946
01947
01948
01949
01950
01951
01952
01953
01954
01955
01956
01957
01958
01959
01960
01961
01962
01963
01964
01965
01966
01967
01968
01969 #endif
01970
01971
01972
01973
01974
01975 #ifdef DEBUG
01976 WRITE(il_chanel,*) ' '
01977 WRITE(il_chanel,*) '* Get persistent details '
01978 #endif
01979
01980 IF (iga_comp_nb_persis(1) .gt. 0) THEN
01981
01982 CALL init_persis (iga_comp_nb_persis(1), &
01983 sga_smioc_persis, &
01984 id_err )
01985 IF (id_err .ne. 0) WRITE(il_chanel,*) 'WARNING: Pb in init_persis'
01986
01987 IF (Appl%stand_alone) THEN
01988
01989 #ifdef CIM
01990 iga_comp_nb_persis(1) = 0
01991 #else
01992 CALL get_persis_details (iga_comp_id_doc_XML(1), &
01993 iga_comp_nb_persis(1), &
01994 sga_smioc_persis, &
01995 id_err )
01996 IF (id_err .ne. 0) &
01997 WRITE(il_chanel,*) 'WARNING: Pb in get_persis_details'
01998 #endif
01999
02000 sga_smioc_persis(:)%ig_comp_id = 1
02001 DO ib_p = 1, iga_comp_nb_persis(1)
02002 sga_smioc_persis(ib_p)%ig_persis_id = ib_p
02003 ENDDO
02004
02005 ELSE
02006
02007 ALLOCATE(ila_smioc_recv(4*iga_comp_nb_persis(1)), stat=id_err)
02008 IF (id_err > 0) THEN
02009 ierrp (1) = id_err
02010 ierrp (2) = 4*iga_comp_nb_persis(1)
02011 id_err = 13
02012
02013 call psmile_error ( id_err, 'ila_smioc_recv', &
02014 ierrp, 2, __FILE__, __LINE__ )
02015 RETURN
02016 ENDIF
02017 ALLOCATE(cla_smioc_recv(5*iga_comp_nb_persis(1)), stat=id_err)
02018 IF (id_err > 0) THEN
02019 ierrp (1) = id_err
02020 ierrp (2) = 5*iga_comp_nb_persis(1)
02021 id_err = 13
02022
02023 call psmile_error ( id_err, 'cla_smioc_recv', &
02024 ierrp, 2, __FILE__, __LINE__ )
02025 RETURN
02026 ENDIF
02027 ALLOCATE(rla_smioc_recv(3*iga_comp_nb_persis(1)), stat=id_err)
02028 IF (id_err > 0) THEN
02029 ierrp (1) = id_err
02030 ierrp (2) = 3*iga_comp_nb_persis(1)
02031 id_err = 13
02032
02033 call psmile_error ( id_err, 'rla_smioc_recv', &
02034 ierrp, 2, __FILE__, __LINE__ )
02035 RETURN
02036 ENDIF
02037
02038 CALL MPI_Recv (ila_smioc_recv, 4*iga_comp_nb_persis(1), &
02039 MPI_Integer, PRISMdrv_root, 30, comm_trans, il_status, id_err)
02040
02041 CALL MPI_Recv (cla_smioc_recv, max_name*5*iga_comp_nb_persis(1), &
02042 MPI_Character, PRISMdrv_root, 31, comm_trans, il_status, id_err)
02043
02044 CALL MPI_Recv (rla_smioc_recv, 3*iga_comp_nb_persis(1), &
02045 MPI_Real, PRISMdrv_root, 32, comm_trans, il_status, id_err)
02046
02047 IF (id_err .ne. 0) &
02048 WRITE(il_chanel,*) 'WARNING: Pb in get_unitsets_details'
02049
02050 il_index = 1
02051 DO ib= 1, iga_comp_nb_persis(1)
02052
02053 sga_smioc_persis(ib)%ig_comp_id = ila_smioc_recv(1 + (ib-1)*4)
02054 sga_smioc_persis(ib)%ig_persis_id = ila_smioc_recv(2 + (ib-1)*4)
02055 sga_smioc_persis(ib)%ig_persis_type = ila_smioc_recv(3 + (ib-1)*4)
02056 sga_smioc_persis(ib)%ig_datatype = ila_smioc_recv(4 + (ib-1)*4)
02057
02058 sga_smioc_persis(ib)%cg_local_name = cla_smioc_recv(1 + (ib-1)*5)
02059 sga_smioc_persis(ib)%cg_stand_name = cla_smioc_recv(2 + (ib-1)*5)
02060 sga_smioc_persis(ib)%cg_long_name = cla_smioc_recv(3 + (ib-1)*5)
02061 sga_smioc_persis(ib)%cg_comp_name = cla_smioc_recv(4 + (ib-1)*5)
02062 sga_smioc_persis(ib)%cg_units = cla_smioc_recv(5 + (ib-1)*5)
02063
02064 sga_smioc_persis(ib)%rg_persis_min = rla_smioc_recv(1 + (ib-1)*3)
02065 sga_smioc_persis(ib)%rg_persis_max = rla_smioc_recv(2 + (ib-1)*3)
02066 sga_smioc_persis(ib)%rg_persis = rla_smioc_recv(3 + (ib-1)*3)
02067
02068 END DO
02069
02070 DEALLOCATE(ila_smioc_recv, stat=id_err)
02071 IF (id_err > 0) THEN
02072 ierrp (1) = id_err
02073 id_err = 14
02074
02075 call psmile_error ( id_err, 'ila_smioc_recv', &
02076 ierrp, 1, __FILE__, __LINE__ )
02077 RETURN
02078 ENDIF
02079 DEALLOCATE(cla_smioc_recv, stat=id_err)
02080 IF (id_err > 0) THEN
02081 ierrp (1) = id_err
02082 id_err = 14
02083
02084 call psmile_error ( id_err, 'cla_smioc_recv', &
02085 ierrp, 1, __FILE__, __LINE__ )
02086 RETURN
02087 ENDIF
02088 DEALLOCATE(rla_smioc_recv, stat=id_err)
02089 IF (id_err > 0) THEN
02090 ierrp (1) = id_err
02091 id_err = 14
02092
02093 call psmile_error ( id_err, 'rla_smioc_recv', &
02094 ierrp, 1, __FILE__, __LINE__ )
02095 RETURN
02096 ENDIF
02097 END IF
02098 END IF
02099
02100 #ifdef DEBUG
02101 WRITE(il_chanel,*) ' '
02102 WRITE(il_chanel,*) '* The total number of persistents : ', &
02103 iga_comp_nb_persis(1)
02104 call psmile_flushstd(il_chanel)
02105 #endif
02106
02107 IF (Appl%stand_alone) THEN
02108
02109 ierrp(1) = sasa_c_close (iga_comp_id_doc_XML(1))
02110 END IF
02111
02112
02113
02114
02115
02116
02117 #ifdef DEBUG
02118 WRITE(il_chanel,*) ' '
02119 IF (iga_comp_nb_grids(1) .gt. 0) THEN
02120 CALL write_grids_details (iga_comp_nb_grids(1), &
02121 sga_smioc_grids, il_chanel, id_err )
02122 IF (id_err .ne. 0) WRITE(il_chanel,*) &
02123 'WARNING: Pb in write_grids_details'
02124 END IF
02125
02126
02127 IF (iga_comp_nb_transi(1) .gt. 0) THEN
02128 CALL write_transi_details (iga_comp_nb_transi(1), &
02129 sga_smioc_transi, il_chanel, id_err )
02130 IF (id_err .ne. 0) WRITE(il_chanel,*) &
02131 'WARNING: Pb in write_transi_details'
02132 END IF
02133
02134
02135 IF (iga_comp_nb_persis(1) .gt. 0) THEN
02136 CALL write_persis_details (iga_comp_nb_persis(1), &
02137 sga_smioc_persis, il_chanel, id_err )
02138 IF (id_err .ne. 0) WRITE(il_chanel,*) &
02139 'WARNING: Pb in write_persis_details'
02140 END IF
02141 WRITE(il_chanel,*) ' '
02142
02143 #endif
02144
02145 #ifdef VERBOSE
02146 print 9980, trim(ch_id), id_err
02147
02148 call psmile_flushstd
02149 #endif /* VERBOSE */
02150
02151 9990 format (1x, a, ': psmile_smioc_init: comp_id =', i3)
02152 9980 format (1x, a, ': psmile_smioc_init: eof, ierror =', i3)
02153
02154
02155 END SUBROUTINE PSMILe_smioc_init