Changeset 2673 for branches/dev_r2586_dynamic_mem/NEMOGCM
- Timestamp:
- 2011-03-08T17:44:21+01:00 (12 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF
- Files:
-
- 38 edited
- 2 copied
-
AGRIF_FILES/modarrays.F (modified) (1 diff)
-
AGRIF_FILES/modbc.F (modified) (19 diffs)
-
AGRIF_FILES/modbcfunction.F (modified) (57 diffs)
-
AGRIF_FILES/modcluster.F (modified) (1 diff)
-
AGRIF_FILES/modcurgridfunctions.F (modified) (4 diffs)
-
AGRIF_FILES/modinit.F (modified) (7 diffs)
-
AGRIF_FILES/modinterp.F (modified) (25 diffs)
-
AGRIF_FILES/modinterpbasic.F (modified) (10 diffs)
-
AGRIF_FILES/modlinktomodel.F (modified) (1 diff)
-
AGRIF_FILES/modmpp.F (modified) (47 diffs)
-
AGRIF_FILES/modsauv.F (modified) (8 diffs)
-
AGRIF_FILES/modtypes.F (modified) (7 diffs)
-
AGRIF_FILES/modupdate.F (modified) (29 diffs)
-
AGRIF_FILES/modupdatebasic.F (modified) (4 diffs)
-
AGRIF_FILES/modutil.F (modified) (7 diffs)
-
AGRIF_FILES/modvariables.F (copied) (copied from vendors/AGRIF/current/AGRIF_FILES/modvariables.F)
-
LIB/DiversListe.c (modified) (4 diffs)
-
LIB/Makefile.lex (modified) (2 diffs)
-
LIB/Makefile.lex.byacc (copied) (copied from vendors/AGRIF/current/LIB/Makefile.lex.byacc)
-
LIB/SubLoopCreation.c (modified) (21 diffs)
-
LIB/UtilAgrif.c (modified) (6 diffs)
-
LIB/UtilCharacter.c (modified) (3 diffs)
-
LIB/UtilFortran.c (modified) (4 diffs)
-
LIB/UtilListe.c (modified) (8 diffs)
-
LIB/WorkWithParameterlist.c (modified) (1 diff)
-
LIB/WorkWithlistdatavariable.c (modified) (2 diffs)
-
LIB/WorkWithlistofmodulebysubroutine.c (modified) (3 diffs)
-
LIB/WorkWithlistvarindoloop.c (modified) (29 diffs)
-
LIB/WriteInFile.c (modified) (2 diffs)
-
LIB/Writedeclarations.c (modified) (14 diffs)
-
LIB/decl.h (modified) (14 diffs)
-
LIB/dependfile.c (modified) (8 diffs)
-
LIB/fortran.c (modified) (135 diffs)
-
LIB/fortran.lex (modified) (8 diffs)
-
LIB/fortran.tab.c (modified) (64 diffs)
-
LIB/fortran.y (modified) (32 diffs)
-
LIB/fortran.yy.c (modified) (68 diffs)
-
LIB/main.c (modified) (71 diffs)
-
LIB/run (modified) (1 prop)
-
LIB/toamr.c (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modarrays.F
r2528 r2673 126 126 C Local variables 127 127 C 128 SELECT CASE (nbdim) 129 CASE (1) 130 lower = lbound(Variable % array1,indice) 131 upper = ubound(Variable % array1,indice) 132 CASE (2) 133 lower = lbound(Variable % array2,indice) 134 upper = ubound(Variable % array2,indice) 135 CASE (3) 136 lower = lbound(Variable % array3,indice) 137 upper = ubound(Variable % array3,indice) 138 CASE (4) 139 lower = lbound(Variable % array4,indice) 140 upper = ubound(Variable % array4,indice) 141 CASE (5) 142 lower = lbound(Variable % array5,indice) 143 upper = ubound(Variable % array5,indice) 144 CASE (6) 145 lower = lbound(Variable % array6,indice) 146 upper = ubound(Variable % array6,indice) 147 END SELECT 148 C 128 129 lower = Variable % lb(indice) 130 upper = Variable % ub(indice) 149 131 return 150 132 C -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbc.F
r2528 r2673 86 86 C 87 87 C Values of the grid variable 88 childtemp % var % array1 => tab88 childtemp % var % parray1 => tab 89 89 C 90 90 C Temporary results for the time interpolation before and after the space … … 167 167 C 168 168 C Values of the grid variable 169 childtemp % var % array2 => tab169 childtemp % var % parray2 => tab 170 170 C 171 171 C Temporary results for the time interpolation before and after the space … … 247 247 C 248 248 C Values of the grid variable 249 childtemp % var % array3 => tab249 childtemp % var % parray3 => tab 250 250 C 251 251 C Temporary results for the time interpolation before and after the space … … 328 328 C 329 329 C Values of the grid variable 330 childtemp % var % array4 => tab330 childtemp % var % parray4 => tab 331 331 C 332 332 C Temporary results for the time interpolation before and after the space … … 409 409 C 410 410 C Values of the grid variable 411 childtemp % var % array5 => tab411 childtemp % var % parray5 => tab 412 412 C 413 413 C Temporary results for the time interpolation before and after the space … … 491 491 C 492 492 C Values of the grid variable 493 childtemp % var % array6 => tab493 childtemp % var % parray6 => tab 494 494 C 495 495 C Temporary results for the time interpolation before and after the space … … 814 814 815 815 CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN, 816 & MPI_COMM_ AGRIF,code)816 & MPI_COMM_WORLD,code) 817 817 818 818 lubglob(1:nbdim,2) = - lubglob(1:nbdim,2) … … 1067 1067 do ir=bounds(1,1),bounds(1,2) 1068 1068 child%var%oldvalues2d(2,kindex) = 1069 & child%var% array1(ir)1069 & child%var%parray1(ir) 1070 1070 kindex = kindex + 1 1071 1071 enddo … … 1077 1077 do ir=bounds(1,1),bounds(1,2) 1078 1078 child%var%oldvalues2d(2,kindex) = 1079 & child%var% array2(ir,jr)1079 & child%var%parray2(ir,jr) 1080 1080 kindex = kindex + 1 1081 1081 enddo … … 1088 1088 do ir=bounds(1,1),bounds(1,2) 1089 1089 child%var%oldvalues2d(2,kindex) = 1090 & child%var% array3(ir,jr,kr)1090 & child%var%parray3(ir,jr,kr) 1091 1091 kindex = kindex + 1 1092 1092 enddo … … 1101 1101 do ir=bounds(1,1),bounds(1,2) 1102 1102 child%var%oldvalues2d(2,kindex) = 1103 & child%var% array4(ir,jr,kr,lr)1103 & child%var%parray4(ir,jr,kr,lr) 1104 1104 kindex = kindex + 1 1105 1105 enddo … … 1116 1116 do ir=bounds(1,1),bounds(1,2) 1117 1117 child%var%oldvalues2d(2,kindex) = 1118 & child%var% array5(ir,jr,kr,lr,mr)1118 & child%var%parray5(ir,jr,kr,lr,mr) 1119 1119 kindex = kindex + 1 1120 1120 enddo … … 1133 1133 do ir=bounds(1,1),bounds(1,2) 1134 1134 child%var%oldvalues2d(2,kindex) = 1135 & child%var% array6(ir,jr,kr,lr,mr,nr)1135 & child%var%parray6(ir,jr,kr,lr,mr,nr) 1136 1136 kindex = kindex + 1 1137 1137 enddo … … 1184 1184 !CDIR ALTCODE 1185 1185 do ir=bounds(1,1),bounds(1,2) 1186 child%var% array1(ir) =1186 child%var%parray1(ir) = 1187 1187 & c2t*child % var % oldvalues2d(1,kindex) 1188 1188 & + c1t*child % var % oldvalues2d(2,kindex) … … 1195 1195 !CDIR ALTCODE 1196 1196 do ir=bounds(1,1),bounds(1,2) 1197 child%var% array2(ir,jr) =1197 child%var%parray2(ir,jr) = 1198 1198 & c2t*child % var % oldvalues2d(1,kindex) 1199 1199 & + c1t*child % var % oldvalues2d(2,kindex) … … 1207 1207 !CDIR ALTCODE 1208 1208 do ir=bounds(1,1),bounds(1,2) 1209 child%var% array3(ir,jr,kr) =1209 child%var%parray3(ir,jr,kr) = 1210 1210 & c2t*child % var % oldvalues2d(1,kindex) 1211 1211 & + c1t*child % var % oldvalues2d(2,kindex) … … 1221 1221 !CDIR ALTCODE 1222 1222 do ir=bounds(1,1),bounds(1,2) 1223 child%var% array4(ir,jr,kr,lr) =1223 child%var%parray4(ir,jr,kr,lr) = 1224 1224 & c2t*child % var % oldvalues2d(1,kindex) 1225 1225 & + c1t*child % var % oldvalues2d(2,kindex) … … 1237 1237 !CDIR ALTCODE 1238 1238 do ir=bounds(1,1),bounds(1,2) 1239 child%var% array5(ir,jr,kr,lr,mr) =1239 child%var%parray5(ir,jr,kr,lr,mr) = 1240 1240 & c2t*child % var % oldvalues2d(1,kindex) 1241 1241 & + c1t*child % var % oldvalues2d(2,kindex) … … 1255 1255 !CDIR ALTCODE 1256 1256 do ir=bounds(1,1),bounds(1,2) 1257 child%var% array6(ir,jr,kr,lr,mr,nr) =1257 child%var%parray6(ir,jr,kr,lr,mr,nr) = 1258 1258 & c2t*child % var % oldvalues2d(1,kindex) 1259 1259 & + c1t*child % var % oldvalues2d(2,kindex) -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modbcfunction.F
r2528 r2673 35 35 Use Agrif_Update 36 36 Use Agrif_fluxmod 37 Use Agrif_Save 37 38 C 38 39 IMPLICIT NONE … … 65 66 & Agrif_Init_variable1d, 66 67 & Agrif_Init_variable2d, 67 & Agrif_Init_variable3d 68 & Agrif_Init_variable3d, 69 & Agrif_Init_variable4d 68 70 end interface 69 71 C … … 76 78 & Agrif_update_var5d 77 79 end interface 80 81 interface Agrif_Save_Forrestore 82 module procedure Agrif_Save_Forrestore0d, 83 & Agrif_Save_Forrestore2d, 84 & Agrif_Save_Forrestore3d, 85 & Agrif_Save_Forrestore4d 86 end interface 78 87 C 79 88 Contains … … 255 264 LOGICAL, OPTIONAL :: Interpolationshouldbemade 256 265 C 257 INTEGER :: tabvarsindic ! indice of the variable in tabvars266 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 258 267 TYPE(Agrif_PVariable),Pointer ::tabvars 259 268 … … 265 274 C 266 275 267 if (tabvarsindic <=0) then 268 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-tabvarsindic) 269 else 270 tabvars=>Agrif_Curgrid % tabvars(tabvarsindic) 276 indic = tabvarsindic 277 if (tabvarsindic >=0) then 278 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 279 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 280 endif 281 endif 282 283 if (indic <=0) then 284 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 285 else 286 tabvars=>Agrif_Curgrid % tabvars(indic) 271 287 endif 272 288 … … 307 323 INTEGER, OPTIONAL :: interp,interp1,interp2,interp3 308 324 C 309 INTEGER :: tabvarsindic ! indice of the variable in tabvars 325 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 326 TYPE(Agrif_PVariable),Pointer ::tabvars 327 328 329 C 310 330 C 311 331 C Begin 312 332 C 313 Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp = 333 C 334 indic = tabvarsindic 335 if (tabvarsindic >=0) then 336 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 337 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 338 endif 339 endif 340 341 if (indic <=0) then 342 tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 343 else 344 tabvars=>Agrif_Mygrid % tabvars(indic) 345 endif 346 C 347 C Begin 348 C 349 tabvars % var % Typeinterp = 314 350 & Agrif_Constant 315 351 IF (present(interp)) THEN 316 Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp =352 tabvars % var % Typeinterp = 317 353 & interp 318 354 ENDIF 319 355 IF (present(interp1)) THEN 320 Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(1) =356 tabvars % var % Typeinterp(1) = 321 357 & interp1 322 358 ENDIF 323 359 IF (present(interp2)) THEN 324 Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(2) =360 tabvars % var % Typeinterp(2) = 325 361 & interp2 326 362 ENDIF 327 363 IF (present(interp3)) THEN 328 Agrif_Mygrid % tabvars(tabvarsindic)% var % Typeinterp(3) =364 tabvars % var % Typeinterp(3) = 329 365 & interp3 330 366 ENDIF … … 353 389 INTEGER, OPTIONAL :: interp11,interp12,interp21,interp22 354 390 C 355 INTEGER :: tabvarsindic ! indice of the variable in tabvars391 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 356 392 TYPE(Agrif_PVariable),Pointer ::tabvars 357 393 … … 363 399 C 364 400 365 if (tabvarsindic <=0) then 366 tabvars => Agrif_Search_Variable(Agrif_Mygrid,-tabvarsindic) 367 else 368 tabvars=>Agrif_Mygrid % tabvars(tabvarsindic) 401 indic = tabvarsindic 402 if (tabvarsindic >=0) then 403 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 404 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 405 endif 406 endif 407 408 if (indic <=0) then 409 tabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 410 else 411 tabvars=>Agrif_Mygrid % tabvars(indic) 369 412 endif 370 413 C … … 460 503 & update2, update3,update4,update5 461 504 C 462 INTEGER :: tabvarsindic ! indice of the variable in tabvars 505 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 506 TYPE(Agrif_PVariable),Pointer :: roottabvars 463 507 C 464 508 C 465 509 C Begin 466 C 467 Agrif_Mygrid % tabvars(tabvarsindic) % var % typeupdate = 510 511 indic = tabvarsindic 512 513 if (tabvarsindic >=0) then 514 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 515 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 516 endif 517 endif 518 519 if (indic <=0) then 520 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 521 else 522 roottabvars => Agrif_Mygrid % tabvars(indic) 523 endif 524 525 C 526 roottabvars% var % typeupdate = 468 527 & Agrif_Update_Copy 469 528 470 529 IF (present(update)) THEN 471 Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate =530 roottabvars% var % typeupdate = 472 531 & update 473 532 ENDIF 474 533 IF (present(update1)) THEN 475 Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(1) =534 roottabvars% var % typeupdate(1) = 476 535 & update1 477 536 ENDIF 478 537 IF (present(update2)) THEN 479 Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(2) =538 roottabvars% var % typeupdate(2) = 480 539 & update2 481 540 ENDIF 482 541 IF (present(update3)) THEN 483 Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(3) =542 roottabvars% var % typeupdate(3) = 484 543 & update3 485 544 ENDIF 486 545 IF (present(update4)) THEN 487 Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(4) =546 roottabvars% var % typeupdate(4) = 488 547 & update4 489 548 ENDIF 490 549 IF (present(update5)) THEN 491 Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate(5) =550 roottabvars% var % typeupdate(5) = 492 551 & update5 493 552 ENDIF … … 513 572 C Arguments 514 573 C 515 INTEGER :: tabvarsindic ! indice of the variable in tabvars574 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 516 575 C 517 576 C Begin 518 577 C 519 C 520 Agrif_Mygrid%tabvars(tabvarsindic)%var % restaure = .TRUE. 578 indic = tabvarsindic 579 if (tabvarsindic >=0) then 580 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 581 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 582 endif 583 endif 584 C 585 Agrif_Mygrid%tabvars(indic)%var % restaure = .TRUE. 521 586 C 522 587 End Subroutine Agrif_Set_restore … … 530 595 531 596 INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 532 INTEGER :: tabvarsindic ! indice of the variable in tabvars597 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 533 598 External :: procname 534 599 Optional :: procname … … 536 601 if (Agrif_Root()) Return 537 602 C 603 indic = tabvarsindic 604 if (tabvarsindic >=0) then 605 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 606 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 607 endif 608 endif 609 538 610 if (present(procname)) then 539 CALL Agrif_Interp_variable(tabvarsindic0, tabvarsindic,procname)540 CALL Agrif_Bc_variable(tabvarsindic0, tabvarsindic,1.,procname)541 else 542 CALL Agrif_Interp_variable(tabvarsindic0, tabvarsindic)543 CALL Agrif_Bc_variable(tabvarsindic0, tabvarsindic,1.)611 CALL Agrif_Interp_variable(tabvarsindic0,indic,procname) 612 CALL Agrif_Bc_variable(tabvarsindic0,indic,1.,procname) 613 else 614 CALL Agrif_Interp_variable(tabvarsindic0,indic) 615 CALL Agrif_Bc_variable(tabvarsindic0,indic,1.) 544 616 endif 545 617 … … 553 625 554 626 REAL, DIMENSION(:) :: q 555 INTEGER :: tabvarsindic ! indice of the variable in tabvars627 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 556 628 External :: procname 557 629 Optional :: procname … … 559 631 C 560 632 if (Agrif_Root()) Return 633 C 634 indic = tabvarsindic 635 if (tabvarsindic >=0) then 636 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 637 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 638 endif 639 endif 561 640 C 562 641 if (present(procname)) then 563 CALL Agrif_Interp_variable(q, tabvarsindic,procname)564 CALL Agrif_Bc_variable(q, tabvarsindic,1.,procname)565 else 566 CALL Agrif_Interp_variable(q, tabvarsindic)567 CALL Agrif_Bc_variable(q, tabvarsindic,1.)642 CALL Agrif_Interp_variable(q,indic,procname) 643 CALL Agrif_Bc_variable(q,indic,1.,procname) 644 else 645 CALL Agrif_Interp_variable(q,indic) 646 CALL Agrif_Bc_variable(q,indic,1.) 568 647 endif 569 648 … … 579 658 External :: procname 580 659 Optional :: procname 660 integer :: indic 581 661 582 662 C 583 663 if (Agrif_Root()) Return 584 664 C 665 indic = tabvarsindic 666 if (tabvarsindic >=0) then 667 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 668 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 669 endif 670 endif 671 585 672 if (present(procname)) then 586 CALL Agrif_Interp_variable(q, tabvarsindic,procname)587 CALL Agrif_Bc_variable(q, tabvarsindic,1.,procname)588 else 589 CALL Agrif_Interp_variable(q, tabvarsindic)590 CALL Agrif_Bc_variable(q, tabvarsindic,1.)673 CALL Agrif_Interp_variable(q,indic,procname) 674 CALL Agrif_Bc_variable(q,indic,1.,procname) 675 else 676 CALL Agrif_Interp_variable(q,indic) 677 CALL Agrif_Bc_variable(q,indic,1.) 591 678 endif 592 679 … … 601 688 602 689 REAL, DIMENSION(:,:,:) :: q 603 INTEGER :: tabvarsindic ! indice of the variable in tabvars690 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 604 691 External :: procname 605 692 Optional :: procname 606 693 C 607 694 if (Agrif_Root()) Return 695 C 696 indic = tabvarsindic 697 if (tabvarsindic >=0) then 698 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 699 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 700 endif 701 endif 608 702 C 609 703 if (present(procname)) then 610 CALL Agrif_Interp_variable(q, tabvarsindic,procname)611 CALL Agrif_Bc_variable(q, tabvarsindic,1.,procname)612 else 613 CALL Agrif_Interp_variable(q, tabvarsindic)614 CALL Agrif_Bc_variable(q, tabvarsindic,1.)704 CALL Agrif_Interp_variable(q,indic,procname) 705 CALL Agrif_Bc_variable(q,indic,1.,procname) 706 else 707 CALL Agrif_Interp_variable(q,indic) 708 CALL Agrif_Bc_variable(q,indic,1.) 615 709 endif 616 710 … … 625 719 626 720 REAL, DIMENSION(:,:,:,:) :: q 627 INTEGER :: tabvarsindic ! indice of the variable in tabvars721 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 628 722 External :: procname 629 723 Optional :: procname 630 724 C 631 725 if (Agrif_Root()) Return 726 C 727 indic = tabvarsindic 728 if (tabvarsindic >=0) then 729 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 730 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 731 endif 732 endif 632 733 C 633 734 if (present(procname)) then 634 CALL Agrif_Interp_variable(q, tabvarsindic,procname)635 CALL Agrif_Bc_variable(q, tabvarsindic,1.,procname)636 else 637 CALL Agrif_Interp_variable(q, tabvarsindic)638 CALL Agrif_Bc_variable(q, tabvarsindic,1.)735 CALL Agrif_Interp_variable(q,indic,procname) 736 CALL Agrif_Bc_variable(q,indic,1.,procname) 737 else 738 CALL Agrif_Interp_variable(q,indic) 739 CALL Agrif_Bc_variable(q,indic,1.) 639 740 endif 640 741 … … 798 899 External :: procname 799 900 Optional :: procname 800 INTEGER :: tabvarsindic ! indice of the variable in tabvars901 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 801 902 C 802 903 REAL, OPTIONAL :: calledweight … … 808 909 C 809 910 If (Agrif_Root()) Return 911 C 912 indic = tabvarsindic 913 if (tabvarsindic >=0) then 914 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 915 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 916 endif 917 endif 810 918 811 919 if ( PRESENT(calledweight) ) then … … 817 925 endif 818 926 819 if ( tabvarsindic <=0) then820 tabvars => Agrif_Search_Variable(Agrif_Curgrid,- tabvarsindic)927 if (indic <=0) then 928 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 821 929 parenttabvars => tabvars%parent_var 822 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,- tabvarsindic)823 else 824 tabvars=>Agrif_Curgrid % tabvars( tabvarsindic)825 parenttabvars => Agrif_Curgrid % parent % tabvars( tabvarsindic)826 roottabvars => Agrif_Mygrid % tabvars( tabvarsindic)930 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 931 else 932 tabvars=>Agrif_Curgrid % tabvars(indic) 933 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 934 roottabvars => Agrif_Mygrid % tabvars(indic) 827 935 endif 828 936 … … 856 964 External :: procname 857 965 Optional :: procname 858 INTEGER :: tabvarsindic ! indice of the variable in tabvars966 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 859 967 C 860 968 REAL, OPTIONAL :: calledweight … … 866 974 C 867 975 If (Agrif_Root()) Return 976 C 977 indic = tabvarsindic 978 if (tabvarsindic >=0) then 979 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 980 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 981 endif 982 endif 868 983 869 984 if ( PRESENT(calledweight) ) then … … 875 990 endif 876 991 877 if ( tabvarsindic <=0) then878 tabvars => Agrif_Search_Variable(Agrif_Curgrid,- tabvarsindic)992 if (indic <=0) then 993 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 879 994 parenttabvars => tabvars%parent_var 880 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,- tabvarsindic)881 else 882 tabvars=>Agrif_Curgrid % tabvars( tabvarsindic)883 parenttabvars => Agrif_Curgrid % parent % tabvars( tabvarsindic)884 roottabvars => Agrif_Mygrid % tabvars( tabvarsindic)995 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 996 else 997 tabvars=>Agrif_Curgrid % tabvars(indic) 998 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 999 roottabvars => Agrif_Mygrid % tabvars(indic) 885 1000 endif 886 1001 … … 914 1029 External :: procname 915 1030 Optional :: procname 916 INTEGER :: tabvarsindic ! indice of the variable in tabvars1031 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 917 1032 C 918 1033 REAL, OPTIONAL :: calledweight … … 924 1039 C 925 1040 If (Agrif_Root()) Return 1041 C 1042 indic = tabvarsindic 1043 if (tabvarsindic >=0) then 1044 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1045 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1046 endif 1047 endif 926 1048 927 1049 if ( PRESENT(calledweight) ) then … … 933 1055 endif 934 1056 935 if ( tabvarsindic <=0) then936 tabvars => Agrif_Search_Variable(Agrif_Curgrid,- tabvarsindic)1057 if (indic <=0) then 1058 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 937 1059 parenttabvars => tabvars%parent_var 938 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,- tabvarsindic)939 else 940 tabvars=>Agrif_Curgrid % tabvars( tabvarsindic)941 parenttabvars => Agrif_Curgrid % parent % tabvars( tabvarsindic)942 roottabvars => Agrif_Mygrid % tabvars( tabvarsindic)1060 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1061 else 1062 tabvars=>Agrif_Curgrid % tabvars(indic) 1063 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1064 roottabvars => Agrif_Mygrid % tabvars(indic) 943 1065 endif 944 1066 … … 972 1094 External :: procname 973 1095 Optional :: procname 974 INTEGER :: tabvarsindic ! indice of the variable in tabvars1096 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 975 1097 C 976 1098 REAL, OPTIONAL :: calledweight … … 983 1105 If (Agrif_Root()) Return 984 1106 1107 C 1108 indic = tabvarsindic 1109 if (tabvarsindic >=0) then 1110 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1111 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1112 endif 1113 endif 1114 985 1115 if ( PRESENT(calledweight) ) then 986 1116 weight=calledweight … … 991 1121 endif 992 1122 993 if ( tabvarsindic <=0) then994 tabvars => Agrif_Search_Variable(Agrif_Curgrid,- tabvarsindic)1123 if (indic <=0) then 1124 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 995 1125 parenttabvars => tabvars%parent_var 996 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,- tabvarsindic)997 else 998 tabvars=>Agrif_Curgrid % tabvars( tabvarsindic)999 parenttabvars => Agrif_Curgrid % parent % tabvars( tabvarsindic)1000 roottabvars => Agrif_Mygrid % tabvars( tabvarsindic)1126 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1127 else 1128 tabvars=>Agrif_Curgrid % tabvars(indic) 1129 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1130 roottabvars => Agrif_Mygrid % tabvars(indic) 1001 1131 endif 1002 1132 … … 1030 1160 External :: procname 1031 1161 Optional :: procname 1032 INTEGER :: tabvarsindic ! indice of the variable in tabvars1162 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 1033 1163 C 1034 1164 REAL, OPTIONAL :: calledweight … … 1040 1170 C 1041 1171 If (Agrif_Root()) Return 1172 C 1173 indic = tabvarsindic 1174 if (tabvarsindic >=0) then 1175 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1176 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1177 endif 1178 endif 1042 1179 1043 1180 if ( PRESENT(calledweight) ) then … … 1049 1186 endif 1050 1187 1051 if ( tabvarsindic <=0) then1052 tabvars => Agrif_Search_Variable(Agrif_Curgrid,- tabvarsindic)1188 if (indic <=0) then 1189 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1053 1190 parenttabvars => tabvars%parent_var 1054 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,- tabvarsindic)1055 else 1056 tabvars=>Agrif_Curgrid % tabvars( tabvarsindic)1057 parenttabvars => Agrif_Curgrid % parent % tabvars( tabvarsindic)1058 roottabvars => Agrif_Mygrid % tabvars( tabvarsindic)1191 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1192 else 1193 tabvars=>Agrif_Curgrid % tabvars(indic) 1194 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1195 roottabvars => Agrif_Mygrid % tabvars(indic) 1059 1196 endif 1060 1197 … … 1086 1223 1087 1224 INTEGER :: tabvarsindic0 ! indice of the variable in tabvars 1088 INTEGER :: tabvarsindic ! indice of the variable in tabvars1225 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 1089 1226 INTEGER :: dimensio ! indice of the variable in tabvars 1090 1227 External :: procname … … 1093 1230 if (Agrif_Root()) Return 1094 1231 C 1095 dimensio = Agrif_Mygrid % tabvars(tabvarsindic) % var % nbdim 1232 indic = tabvarsindic 1233 if (tabvarsindic >=0) then 1234 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1235 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1236 endif 1237 endif 1238 C 1239 dimensio = Agrif_Mygrid % tabvars(indic) % var % nbdim 1096 1240 C 1097 1241 if ( dimensio .EQ. 1 ) then 1098 1242 if (present(procname)) then 1099 1243 Call Agrif_Interp_1D( 1100 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1101 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1102 & Agrif_Curgrid % tabvars( tabvarsindic),1244 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1245 & Agrif_Curgrid % parent % tabvars(indic), 1246 & Agrif_Curgrid % tabvars(indic), 1103 1247 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 , 1104 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1105 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim,procname)1248 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1249 & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 1106 1250 else 1107 1251 Call Agrif_Interp_1D( 1108 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1109 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1110 & Agrif_Curgrid % tabvars( tabvarsindic),1252 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1253 & Agrif_Curgrid % parent % tabvars(indic), 1254 & Agrif_Curgrid % tabvars(indic), 1111 1255 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array1 , 1112 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1113 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim)1256 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1257 & Agrif_Mygrid % tabvars(indic) %var % nbdim) 1114 1258 endif 1115 1259 endif … … 1118 1262 if (present(procname)) then 1119 1263 Call Agrif_Interp_2D( 1120 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1121 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1122 & Agrif_Curgrid % tabvars( tabvarsindic),1264 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1265 & Agrif_Curgrid % parent % tabvars(indic), 1266 & Agrif_Curgrid % tabvars(indic), 1123 1267 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 , 1124 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1125 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim,procname)1268 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1269 & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 1126 1270 else 1127 1271 Call Agrif_Interp_2D( 1128 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1129 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1130 & Agrif_Curgrid % tabvars( tabvarsindic),1272 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1273 & Agrif_Curgrid % parent % tabvars(indic), 1274 & Agrif_Curgrid % tabvars(indic), 1131 1275 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2 , 1132 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1133 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim)1276 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1277 & Agrif_Mygrid % tabvars(indic) %var % nbdim) 1134 1278 endif 1135 1279 endif … … 1138 1282 if (present(procname)) then 1139 1283 Call Agrif_Interp_3D( 1140 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1141 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1142 & Agrif_Curgrid % tabvars( tabvarsindic),1284 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1285 & Agrif_Curgrid % parent % tabvars(indic), 1286 & Agrif_Curgrid % tabvars(indic), 1143 1287 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 , 1144 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1145 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim,procname)1288 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1289 & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 1146 1290 else 1147 1291 Call Agrif_Interp_3D( 1148 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1149 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1150 & Agrif_Curgrid % tabvars( tabvarsindic),1292 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1293 & Agrif_Curgrid % parent % tabvars(indic), 1294 & Agrif_Curgrid % tabvars(indic), 1151 1295 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3 , 1152 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1153 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim)1296 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1297 & Agrif_Mygrid % tabvars(indic) %var % nbdim) 1154 1298 endif 1155 1299 endif … … 1158 1302 if (present(procname)) then 1159 1303 Call Agrif_Interp_4D( 1160 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1161 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1162 & Agrif_Curgrid % tabvars( tabvarsindic),1304 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1305 & Agrif_Curgrid % parent % tabvars(indic), 1306 & Agrif_Curgrid % tabvars(indic), 1163 1307 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 , 1164 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1165 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim,procname)1308 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1309 & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 1166 1310 else 1167 1311 Call Agrif_Interp_4D( 1168 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1169 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1170 & Agrif_Curgrid % tabvars( tabvarsindic),1312 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1313 & Agrif_Curgrid % parent % tabvars(indic), 1314 & Agrif_Curgrid % tabvars(indic), 1171 1315 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4 , 1172 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1173 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim)1316 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1317 & Agrif_Mygrid % tabvars(indic) %var % nbdim) 1174 1318 endif 1175 1319 endif … … 1178 1322 if (present(procname)) then 1179 1323 Call Agrif_Interp_5D( 1180 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1181 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1182 & Agrif_Curgrid % tabvars( tabvarsindic),1324 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1325 & Agrif_Curgrid % parent % tabvars(indic), 1326 & Agrif_Curgrid % tabvars(indic), 1183 1327 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 , 1184 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1185 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim,procname)1328 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1329 & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 1186 1330 else 1187 1331 Call Agrif_Interp_5D( 1188 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1189 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1190 & Agrif_Curgrid % tabvars( tabvarsindic),1332 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1333 & Agrif_Curgrid % parent % tabvars(indic), 1334 & Agrif_Curgrid % tabvars(indic), 1191 1335 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array5 , 1192 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1193 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim)1336 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1337 & Agrif_Mygrid % tabvars(indic) %var % nbdim) 1194 1338 endif 1195 1339 endif … … 1198 1342 if (present(procname)) then 1199 1343 Call Agrif_Interp_6D( 1200 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1201 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1202 & Agrif_Curgrid % tabvars( tabvarsindic),1344 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1345 & Agrif_Curgrid % parent % tabvars(indic), 1346 & Agrif_Curgrid % tabvars(indic), 1203 1347 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 , 1204 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1205 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim,procname)1348 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1349 & Agrif_Mygrid % tabvars(indic) %var % nbdim,procname) 1206 1350 else 1207 1351 Call Agrif_Interp_6D( 1208 & Agrif_Mygrid % tabvars( tabvarsindic) % var % TypeInterp,1209 & Agrif_Curgrid % parent % tabvars( tabvarsindic),1210 & Agrif_Curgrid % tabvars( tabvarsindic),1352 & Agrif_Mygrid % tabvars(indic) % var % TypeInterp, 1353 & Agrif_Curgrid % parent % tabvars(indic), 1354 & Agrif_Curgrid % tabvars(indic), 1211 1355 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array6 , 1212 & Agrif_Mygrid % tabvars( tabvarsindic) % var % restaure,1213 & Agrif_Mygrid % tabvars( tabvarsindic) %var % nbdim)1356 & Agrif_Mygrid % tabvars(indic) % var % restaure, 1357 & Agrif_Mygrid % tabvars(indic) %var % nbdim) 1214 1358 endif 1215 1359 endif … … 1225 1369 1226 1370 REAL, DIMENSION(:) :: q 1227 INTEGER :: tabvarsindic ! indice of the variable in tabvars1371 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 1228 1372 External :: procname 1229 1373 Optional :: procname 1374 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1230 1375 C 1231 1376 if (Agrif_Root()) Return 1232 1377 C 1378 C 1379 indic = tabvarsindic 1380 if (tabvarsindic >=0) then 1381 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1382 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1383 endif 1384 endif 1385 1386 if (indic <=0) then 1387 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1388 parenttabvars => tabvars%parent_var 1389 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1390 else 1391 tabvars=>Agrif_Curgrid % tabvars(indic) 1392 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1393 roottabvars => Agrif_Mygrid % tabvars(indic) 1394 endif 1395 1233 1396 if (present(procname)) then 1234 1397 Call Agrif_Interp_1D( 1235 & Agrif_Mygrid % tabvars(tabvarsindic)% var % TypeInterp,1236 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1237 & Agrif_Curgrid % tabvars(tabvarsindic),q,1238 & Agrif_Mygrid % tabvars(tabvarsindic)% var % restaure,1239 & Agrif_Mygrid % tabvars(tabvarsindic)%var % nbdim,procname)1398 & roottabvars % var % TypeInterp, 1399 & parenttabvars, 1400 & tabvars,q, 1401 & roottabvars % var % restaure, 1402 & roottabvars %var % nbdim,procname) 1240 1403 else 1241 1404 Call Agrif_Interp_1D( 1242 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 1243 & Agrif_Curgrid % parent % tabvars(tabvarsindic), 1244 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1245 & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 1246 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1405 & roottabvars % var % TypeInterp, 1406 & parenttabvars, 1407 & tabvars,q, 1408 & roottabvars % var % restaure, 1409 & roottabvars %var % nbdim) 1410 1247 1411 endif 1248 1412 Return … … 1256 1420 1257 1421 REAL, DIMENSION(:,:) :: q 1258 INTEGER :: tabvarsindic ! indice of the variable in tabvars1422 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 1259 1423 External :: procname 1260 1424 Optional :: procname 1261 1425 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1262 1426 C 1263 1427 if (Agrif_Root()) Return 1264 C 1428 C 1429 indic = tabvarsindic 1430 if (tabvarsindic >=0) then 1431 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1432 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1433 endif 1434 endif 1435 1436 if (indic <=0) then 1437 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1438 parenttabvars => tabvars%parent_var 1439 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1440 if (tabvars%var%restaure) then 1441 if (agrif_curgrid%ngridstep == 0) then 1442 call AGRIF_CopyFromold_AllOneVar 1443 & (Agrif_Curgrid,Agrif_OldMygrid,indic) 1444 endif 1445 endif 1446 else 1447 tabvars=>Agrif_Curgrid % tabvars(indic) 1448 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1449 roottabvars => Agrif_Mygrid % tabvars(indic) 1450 endif 1451 1452 1265 1453 if (present(procname)) then 1266 1454 Call Agrif_Interp_2D( 1267 & Agrif_Mygrid % tabvars(tabvarsindic)% var % TypeInterp,1268 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1269 & Agrif_Curgrid % tabvars(tabvarsindic),q,1270 & Agrif_Mygrid % tabvars(tabvarsindic)% var % restaure,1271 & Agrif_Mygrid % tabvars(tabvarsindic)%var % nbdim,procname)1455 & roottabvars % var % TypeInterp, 1456 & parenttabvars, 1457 & tabvars,q, 1458 & roottabvars % var % restaure, 1459 & roottabvars %var % nbdim,procname) 1272 1460 else 1273 1461 Call Agrif_Interp_2D( 1274 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 1275 & Agrif_Curgrid % parent % tabvars(tabvarsindic), 1276 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1277 & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 1278 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1279 endif 1462 & roottabvars % var % TypeInterp, 1463 & parenttabvars, 1464 & tabvars,q, 1465 & roottabvars % var % restaure, 1466 & roottabvars %var % nbdim) 1467 1468 endif 1280 1469 Return 1281 1470 End Subroutine Agrif_Interp_var2d … … 1288 1477 1289 1478 REAL, DIMENSION(:,:,:) :: q 1290 INTEGER :: tabvarsindic ! indice of the variable in tabvars1479 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 1291 1480 External :: procname 1292 1481 Optional :: procname 1293 1482 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1294 1483 C 1295 1484 if (Agrif_Root()) Return 1296 C 1485 C 1486 1487 indic = tabvarsindic 1488 if (tabvarsindic >=0) then 1489 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1490 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1491 endif 1492 endif 1493 1494 if (indic <=0) then 1495 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1496 parenttabvars => tabvars%parent_var 1497 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1498 if (tabvars%var%restaure) then 1499 if (agrif_curgrid%ngridstep == 0) then 1500 call AGRIF_CopyFromold_AllOneVar 1501 & (Agrif_Curgrid,Agrif_OldMygrid,indic) 1502 endif 1503 endif 1504 else 1505 tabvars=>Agrif_Curgrid % tabvars(indic) 1506 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1507 roottabvars => Agrif_Mygrid % tabvars(indic) 1508 endif 1509 1297 1510 if (present(procname)) then 1298 1511 Call Agrif_Interp_3D( 1299 & Agrif_Mygrid % tabvars(tabvarsindic)% var % TypeInterp,1300 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1301 & Agrif_Curgrid % tabvars(tabvarsindic),q,1302 & Agrif_Mygrid % tabvars(tabvarsindic)% var % restaure,1303 & Agrif_Mygrid % tabvars(tabvarsindic)%var % nbdim,procname)1512 & roottabvars % var % TypeInterp, 1513 & parenttabvars, 1514 & tabvars,q, 1515 & roottabvars % var % restaure, 1516 & roottabvars %var % nbdim,procname) 1304 1517 else 1305 1518 Call Agrif_Interp_3D( 1306 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 1307 & Agrif_Curgrid % parent % tabvars(tabvarsindic), 1308 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1309 & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 1310 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1311 endif 1519 & roottabvars % var % TypeInterp, 1520 & parenttabvars, 1521 & tabvars,q, 1522 & roottabvars % var % restaure, 1523 & roottabvars %var % nbdim) 1524 1525 endif 1312 1526 Return 1313 1527 End Subroutine Agrif_Interp_var3d … … 1320 1534 1321 1535 REAL, DIMENSION(:,:,:,:) :: q 1322 INTEGER :: tabvarsindic ! indice of the variable in tabvars1536 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 1323 1537 External :: procname 1324 1538 Optional :: procname 1325 1539 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1326 1540 C 1327 1541 if (Agrif_Root()) Return 1328 C 1542 C 1543 indic = tabvarsindic 1544 if (tabvarsindic >=0) then 1545 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1546 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1547 endif 1548 endif 1549 1550 if (indic <=0) then 1551 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1552 parenttabvars => tabvars%parent_var 1553 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1554 if (tabvars%var%restaure) then 1555 if (agrif_curgrid%ngridstep == 0) then 1556 call AGRIF_CopyFromold_AllOneVar 1557 & (Agrif_Curgrid,Agrif_OldMygrid,indic) 1558 endif 1559 endif 1560 else 1561 tabvars=>Agrif_Curgrid % tabvars(indic) 1562 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1563 roottabvars => Agrif_Mygrid % tabvars(indic) 1564 endif 1565 1329 1566 if (present(procname)) then 1330 1567 Call Agrif_Interp_4D( 1331 & Agrif_Mygrid % tabvars(tabvarsindic)% var % TypeInterp,1332 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1333 & Agrif_Curgrid % tabvars(tabvarsindic),q,1334 & Agrif_Mygrid % tabvars(tabvarsindic)% var % restaure,1335 & Agrif_Mygrid % tabvars(tabvarsindic)%var % nbdim,procname)1568 & roottabvars % var % TypeInterp, 1569 & parenttabvars, 1570 & tabvars,q, 1571 & roottabvars % var % restaure, 1572 & roottabvars %var % nbdim,procname) 1336 1573 else 1337 1574 Call Agrif_Interp_4D( 1338 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 1339 & Agrif_Curgrid % parent % tabvars(tabvarsindic), 1340 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1341 & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 1342 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1343 endif 1575 & roottabvars % var % TypeInterp, 1576 & parenttabvars, 1577 & tabvars,q, 1578 & roottabvars % var % restaure, 1579 & roottabvars %var % nbdim) 1580 1581 endif 1582 1344 1583 Return 1345 1584 End Subroutine Agrif_Interp_var4d … … 1352 1591 1353 1592 REAL, DIMENSION(:,:,:,:,:) :: q 1354 INTEGER :: tabvarsindic ! indice of the variable in tabvars1593 INTEGER :: tabvarsindic, indic ! indice of the variable in tabvars 1355 1594 External :: procname 1356 1595 Optional :: procname 1357 1596 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1358 1597 C 1359 1598 if (Agrif_Root()) Return 1360 C 1599 C 1600 1601 indic = tabvarsindic 1602 if (tabvarsindic >=0) then 1603 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1604 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1605 endif 1606 endif 1607 1608 if (indic <=0) then 1609 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1610 parenttabvars => tabvars%parent_var 1611 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1612 else 1613 tabvars=>Agrif_Curgrid % tabvars(indic) 1614 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1615 roottabvars => Agrif_Mygrid % tabvars(indic) 1616 endif 1617 1361 1618 if (present(procname)) then 1362 1619 Call Agrif_Interp_5D( 1363 & Agrif_Mygrid % tabvars(tabvarsindic)% var % TypeInterp,1364 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1365 & Agrif_Curgrid % tabvars(tabvarsindic),q,1366 & Agrif_Mygrid % tabvars(tabvarsindic)% var % restaure,1367 & Agrif_Mygrid % tabvars(tabvarsindic)%var % nbdim,procname)1620 & roottabvars % var % TypeInterp, 1621 & parenttabvars, 1622 & tabvars,q, 1623 & roottabvars % var % restaure, 1624 & roottabvars %var % nbdim,procname) 1368 1625 else 1369 1626 Call Agrif_Interp_5D( 1370 & Agrif_Mygrid % tabvars(tabvarsindic) % var % TypeInterp, 1371 & Agrif_Curgrid % parent % tabvars(tabvarsindic), 1372 & Agrif_Curgrid % tabvars(tabvarsindic),q, 1373 & Agrif_Mygrid % tabvars(tabvarsindic) % var % restaure, 1374 & Agrif_Mygrid % tabvars(tabvarsindic) %var % nbdim) 1627 & roottabvars % var % TypeInterp, 1628 & parenttabvars, 1629 & tabvars,q, 1630 & roottabvars % var % restaure, 1631 & roottabvars %var % nbdim) 1632 1375 1633 endif 1376 1634 Return … … 1538 1796 1539 1797 REAL, DIMENSION(:) :: q 1540 INTEGER :: tabvarsindic ! indice of the variable in tabvars1798 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 1541 1799 External :: procname 1542 1800 Optional :: procname … … 1544 1802 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1545 1803 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1804 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1546 1805 C 1547 1806 if (Agrif_Root()) Return 1548 1807 C 1808 1809 indic = tabvarsindic 1810 if (tabvarsindic >=0) then 1811 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1812 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1813 endif 1814 endif 1815 1816 if (indic <=0) then 1817 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1818 parenttabvars => tabvars%parent_var 1819 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1820 else 1821 tabvars=>Agrif_Curgrid % tabvars(indic) 1822 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1823 roottabvars => Agrif_Mygrid % tabvars(indic) 1824 endif 1825 1549 1826 IF (present(locupdate)) THEN 1550 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1)1827 tabvars%var % updateinf(1:1) 1551 1828 & = locupdate(1) 1552 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1)1829 tabvars%var % updatesup(1:1) 1553 1830 & = locupdate(2) 1554 1831 ELSE 1555 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:1)1832 tabvars%var % updateinf(1:1) 1556 1833 & = -99 1557 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:1)1834 tabvars%var % updatesup(1:1) 1558 1835 & = -99 1559 1836 ENDIF 1560 1837 1561 1838 IF (present(locupdate1)) THEN 1562 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)1839 tabvars%var % updateinf(1) 1563 1840 & = locupdate1(1) 1564 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)1841 tabvars%var % updatesup(1) 1565 1842 & = locupdate1(2) 1566 1843 ENDIF 1567 1844 1568 1845 IF (present(locupdate2)) THEN 1569 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)1846 tabvars%var % updateinf(2) 1570 1847 & = locupdate2(1) 1571 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)1848 tabvars%var % updatesup(2) 1572 1849 & = locupdate2(2) 1573 1850 ENDIF … … 1575 1852 IF (present(procname)) THEN 1576 1853 Call Agrif_Update_1D( 1577 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1578 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1579 & Agrif_Curgrid % tabvars(tabvarsindic),q,1580 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1581 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updatesup,1854 & roottabvars % var % typeupdate, 1855 & parenttabvars, 1856 & tabvars,q, 1857 & tabvars % var % updateinf, 1858 & tabvars % var % updatesup, 1582 1859 & procname) 1583 ELSE 1860 ELSE 1584 1861 Call Agrif_Update_1D( 1585 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1586 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1587 & Agrif_Curgrid % tabvars(tabvarsindic),q,1588 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1589 & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)1862 & roottabvars % var % typeupdate, 1863 & parenttabvars, 1864 & tabvars,q, 1865 & tabvars % var % updateinf, 1866 & tabvars % var % updatesup) 1590 1867 ENDIF 1591 1868 … … 1607 1884 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1608 1885 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1609 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1886 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 1887 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1610 1888 C 1611 1889 IF (Agrif_Root()) RETURN 1612 1890 1613 1891 C 1892 indic = tabvarsindic 1893 if (tabvarsindic >=0) then 1894 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1895 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1896 endif 1897 endif 1898 1899 if (indic <=0) then 1900 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1901 parenttabvars => tabvars%parent_var 1902 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1903 else 1904 tabvars=>Agrif_Curgrid % tabvars(indic) 1905 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1906 roottabvars => Agrif_Mygrid % tabvars(indic) 1907 endif 1908 1614 1909 IF (present(locupdate)) THEN 1615 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2)1910 tabvars%var % updateinf(1:2) 1616 1911 & = locupdate(1) 1617 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2)1912 tabvars%var % updatesup(1:2) 1618 1913 & = locupdate(2) 1619 1914 ELSE 1620 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:2)1915 tabvars%var % updateinf(1:2) 1621 1916 & = -99 1622 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:2)1917 tabvars%var % updatesup(1:2) 1623 1918 & = -99 1624 1919 ENDIF 1625 1920 1626 1921 IF (present(locupdate1)) THEN 1627 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)1922 tabvars%var % updateinf(1) 1628 1923 & = locupdate1(1) 1629 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)1924 tabvars%var % updatesup(1) 1630 1925 & = locupdate1(2) 1631 1926 ENDIF 1632 1927 1633 1928 IF (present(locupdate2)) THEN 1634 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)1929 tabvars%var % updateinf(2) 1635 1930 & = locupdate2(1) 1636 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)1931 tabvars%var % updatesup(2) 1637 1932 & = locupdate2(2) 1638 1933 ENDIF … … 1640 1935 IF (present(procname)) THEN 1641 1936 Call Agrif_Update_2D( 1642 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1643 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1644 & Agrif_Curgrid % tabvars(tabvarsindic),q,1645 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1646 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updatesup,1937 & roottabvars % var % typeupdate, 1938 & parenttabvars, 1939 & tabvars,q, 1940 & tabvars % var % updateinf, 1941 & tabvars % var % updatesup, 1647 1942 & procname) 1648 ELSE 1943 ELSE 1649 1944 Call Agrif_Update_2D( 1650 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1651 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1652 & Agrif_Curgrid % tabvars(tabvarsindic),q,1653 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1654 & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)1945 & roottabvars % var % typeupdate, 1946 & parenttabvars, 1947 & tabvars,q, 1948 & tabvars % var % updateinf, 1949 & tabvars % var % updatesup) 1655 1950 ENDIF 1656 1951 … … 1672 1967 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1673 1968 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1674 INTEGER :: tabvarsindic ! indice of the variable in tabvars 1969 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 1970 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1675 1971 C 1676 1972 IF (Agrif_Root()) RETURN 1677 1973 C 1678 1974 indic = tabvarsindic 1975 if (tabvarsindic >=0) then 1976 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 1977 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 1978 endif 1979 endif 1980 1981 if (indic <=0) then 1982 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 1983 parenttabvars => tabvars%parent_var 1984 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 1985 else 1986 tabvars=>Agrif_Curgrid % tabvars(indic) 1987 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 1988 roottabvars => Agrif_Mygrid % tabvars(indic) 1989 endif 1990 1679 1991 IF (present(locupdate)) THEN 1680 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3)1992 tabvars%var % updateinf(1:3) 1681 1993 & = locupdate(1) 1682 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3)1994 tabvars%var % updatesup(1:3) 1683 1995 & = locupdate(2) 1684 1996 ELSE 1685 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:3)1997 tabvars%var % updateinf(1:3) 1686 1998 & = -99 1687 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:3)1999 tabvars%var % updatesup(1:3) 1688 2000 & = -99 1689 2001 ENDIF 1690 2002 1691 2003 IF (present(locupdate1)) THEN 1692 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)2004 tabvars%var % updateinf(1) 1693 2005 & = locupdate1(1) 1694 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)2006 tabvars%var % updatesup(1) 1695 2007 & = locupdate1(2) 1696 2008 ENDIF 1697 2009 1698 2010 IF (present(locupdate2)) THEN 1699 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)2011 tabvars%var % updateinf(2) 1700 2012 & = locupdate2(1) 1701 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)2013 tabvars%var % updatesup(2) 1702 2014 & = locupdate2(2) 1703 2015 ENDIF … … 1705 2017 IF (present(procname)) THEN 1706 2018 Call Agrif_Update_3D( 1707 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1708 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1709 & Agrif_Curgrid % tabvars(tabvarsindic),q,1710 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1711 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updatesup,2019 & roottabvars % var % typeupdate, 2020 & parenttabvars, 2021 & tabvars,q, 2022 & tabvars % var % updateinf, 2023 & tabvars % var % updatesup, 1712 2024 & procname) 1713 ELSE 2025 ELSE 1714 2026 Call Agrif_Update_3D( 1715 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1716 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1717 & Agrif_Curgrid % tabvars(tabvarsindic),q,1718 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1719 & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)2027 & roottabvars % var % typeupdate, 2028 & parenttabvars, 2029 & tabvars,q, 2030 & tabvars % var % updateinf, 2031 & tabvars % var % updatesup) 1720 2032 ENDIF 1721 2033 … … 1737 2049 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1738 2050 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1739 INTEGER :: tabvarsindic ! indice of the variable in tabvars 2051 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 2052 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1740 2053 C 1741 2054 IF (Agrif_Root()) RETURN 2055 indic = tabvarsindic 2056 if (tabvarsindic >=0) then 2057 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 2058 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 2059 endif 2060 endif 2061 2062 if (indic <=0) then 2063 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 2064 parenttabvars => tabvars%parent_var 2065 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 2066 else 2067 tabvars=>Agrif_Curgrid % tabvars(indic) 2068 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 2069 roottabvars => Agrif_Mygrid % tabvars(indic) 2070 endif 1742 2071 C 1743 2072 IF (present(locupdate)) THEN 1744 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4)2073 tabvars%var % updateinf(1:4) 1745 2074 & = locupdate(1) 1746 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4)2075 tabvars%var % updatesup(1:4) 1747 2076 & = locupdate(2) 1748 2077 ELSE 1749 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:4)2078 tabvars%var % updateinf(1:4) 1750 2079 & = -99 1751 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:4)2080 tabvars%var % updatesup(1:4) 1752 2081 & = -99 1753 2082 ENDIF 1754 2083 1755 2084 IF (present(locupdate1)) THEN 1756 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)2085 tabvars%var % updateinf(1) 1757 2086 & = locupdate1(1) 1758 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)2087 tabvars%var % updatesup(1) 1759 2088 & = locupdate1(2) 1760 2089 ENDIF 1761 2090 1762 2091 IF (present(locupdate2)) THEN 1763 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)2092 tabvars%var % updateinf(2) 1764 2093 & = locupdate2(1) 1765 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)2094 tabvars%var % updatesup(2) 1766 2095 & = locupdate2(2) 1767 2096 ENDIF … … 1769 2098 IF (present(procname)) THEN 1770 2099 Call Agrif_Update_4D( 1771 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1772 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1773 & Agrif_Curgrid % tabvars(tabvarsindic),q,1774 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1775 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updatesup,2100 & roottabvars % var % typeupdate, 2101 & parenttabvars, 2102 & tabvars,q, 2103 & tabvars % var % updateinf, 2104 & tabvars % var % updatesup, 1776 2105 & procname) 1777 ELSE 2106 ELSE 1778 2107 Call Agrif_Update_4D( 1779 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1780 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1781 & Agrif_Curgrid % tabvars(tabvarsindic),q,1782 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1783 & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)2108 & roottabvars % var % typeupdate, 2109 & parenttabvars, 2110 & tabvars,q, 2111 & tabvars % var % updateinf, 2112 & tabvars % var % updatesup) 1784 2113 ENDIF 1785 2114 … … 1801 2130 INTEGER, DIMENSION(2), OPTIONAL :: locupdate1 1802 2131 INTEGER, DIMENSION(2), OPTIONAL :: locupdate2 1803 INTEGER :: tabvarsindic ! indice of the variable in tabvars 2132 INTEGER :: tabvarsindic,indic ! indice of the variable in tabvars 2133 TYPE(Agrif_PVariable),Pointer ::tabvars,parenttabvars,roottabvars 1804 2134 C 1805 2135 IF (Agrif_Root()) RETURN 1806 2136 C 2137 indic = tabvarsindic 2138 if (tabvarsindic >=0) then 2139 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 2140 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 2141 endif 2142 endif 2143 2144 if (indic <=0) then 2145 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 2146 parenttabvars => tabvars%parent_var 2147 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 2148 else 2149 tabvars=>Agrif_Curgrid % tabvars(indic) 2150 parenttabvars => Agrif_Curgrid % parent % tabvars(indic) 2151 roottabvars => Agrif_Mygrid % tabvars(indic) 2152 endif 2153 1807 2154 IF (present(locupdate)) THEN 1808 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5)2155 tabvars%var % updateinf(1:5) 1809 2156 & = locupdate(1) 1810 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5)2157 tabvars%var % updatesup(1:5) 1811 2158 & = locupdate(2) 1812 2159 ELSE 1813 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1:5)2160 tabvars%var % updateinf(1:5) 1814 2161 & = -99 1815 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1:5)2162 tabvars%var % updatesup(1:5) 1816 2163 & = -99 1817 2164 ENDIF 1818 2165 1819 2166 IF (present(locupdate1)) THEN 1820 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(1)2167 tabvars%var % updateinf(1) 1821 2168 & = locupdate1(1) 1822 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(1)2169 tabvars%var % updatesup(1) 1823 2170 & = locupdate1(2) 1824 2171 ENDIF 1825 2172 1826 2173 IF (present(locupdate2)) THEN 1827 Agrif_Curgrid%tabvars(tabvarsindic)%var % updateinf(2)2174 tabvars%var % updateinf(2) 1828 2175 & = locupdate2(1) 1829 Agrif_Curgrid%tabvars(tabvarsindic)%var % updatesup(2)2176 tabvars%var % updatesup(2) 1830 2177 & = locupdate2(2) 1831 2178 ENDIF … … 1833 2180 IF (present(procname)) THEN 1834 2181 Call Agrif_Update_5D( 1835 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1836 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1837 & Agrif_Curgrid % tabvars(tabvarsindic),q,1838 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1839 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updatesup,2182 & roottabvars % var % typeupdate, 2183 & parenttabvars, 2184 & tabvars,q, 2185 & tabvars % var % updateinf, 2186 & tabvars % var % updatesup, 1840 2187 & procname) 1841 ELSE 2188 ELSE 1842 2189 Call Agrif_Update_5D( 1843 & Agrif_Mygrid % tabvars(tabvarsindic)% var % typeupdate,1844 & Agrif_Curgrid % parent % tabvars(tabvarsindic),1845 & Agrif_Curgrid % tabvars(tabvarsindic),q,1846 & Agrif_Curgrid % tabvars(tabvarsindic)% var % updateinf,1847 & Agrif_Curgrid % tabvars(tabvarsindic) % var % updatesup)2190 & roottabvars % var % typeupdate, 2191 & parenttabvars, 2192 & tabvars,q, 2193 & tabvars % var % updateinf, 2194 & tabvars % var % updatesup) 1848 2195 ENDIF 1849 2196 … … 1952 2299 End Subroutine Agrif_Flux_Correction 1953 2300 1954 Subroutine Agrif_Declare_Variable(posvar,firstpoint, 1955 & raf,lb,ub,varid) 1956 character*(80) :: variablename 1957 Type(Agrif_List_Variables), Pointer :: newvariable,newvariablep 1958 INTEGER, DIMENSION(:) :: posvar 1959 INTEGER, DIMENSION(:) :: lb,ub 1960 INTEGER, DIMENSION(:) :: firstpoint 1961 CHARACTER(*) ,DIMENSION(:) :: raf 1962 TYPE(Agrif_Pvariable), Pointer :: parent_var,root_var 1963 INTEGER :: dimensio 1964 INTEGER :: varid 1965 1966 if (agrif_root()) return 1967 1968 dimensio = SIZE(posvar) 1969 C 1970 C 1971 Allocate(newvariable) 1972 Allocate(newvariable%pvar) 1973 Allocate(newvariable%pvar%var) 1974 Allocate(newvariable%pvar%var%posvar(dimensio)) 1975 Allocate(newvariable%pvar%var%interptab(dimensio)) 1976 newvariable%pvar%var%variablename = variablename 1977 newvariable%pvar%var%interptab = raf 1978 newvariable%pvar%var%nbdim = dimensio 1979 newvariable%pvar%var%posvar = posvar 1980 newvariable%pvar%var%point(1:dimensio) = firstpoint 1981 newvariable%pvar%var%lb(1:dimensio) = lb(1:dimensio) 1982 newvariable%pvar%var%ub(1:dimensio) = ub(1:dimensio) 1983 1984 newvariable % nextvariable => Agrif_Curgrid%variables 1985 1986 Agrif_Curgrid%variables => newvariable 1987 Agrif_Curgrid%Nbvariables = Agrif_Curgrid%Nbvariables + 1 1988 1989 varid = -Agrif_Curgrid%Nbvariables 1990 1991 if (agrif_curgrid%parent%nbvariables < agrif_curgrid%nbvariables) 1992 & then 1993 Allocate(newvariablep) 1994 Allocate(newvariablep%pvar) 1995 Allocate(newvariablep%pvar%var) 1996 Allocate(newvariablep%pvar%var%posvar(dimensio)) 1997 Allocate(newvariablep%pvar%var%interptab(dimensio)) 1998 newvariablep%pvar%var%variablename = variablename 1999 newvariablep%pvar%var%interptab = raf 2000 newvariablep%pvar%var%nbdim = dimensio 2001 newvariablep%pvar%var%posvar = posvar 2002 newvariablep%pvar%var%point(1:dimensio) = firstpoint 2003 2004 newvariablep % nextvariable => Agrif_Curgrid%parent%variables 2005 2006 Agrif_Curgrid%parent%variables => newvariablep 2007 2008 Agrif_Curgrid%parent%Nbvariables = 2009 & Agrif_Curgrid%parent%Nbvariables + 1 2010 parent_var=>newvariablep%pvar 2011 else 2012 parent_var=>Agrif_Search_Variable 2013 & (Agrif_Curgrid%parent,Agrif_Curgrid%nbvariables) 2014 endif 2015 2016 newvariable%pvar%parent_var=>parent_var 2017 2018 root_var=>Agrif_Search_Variable 2019 & (Agrif_Mygrid,Agrif_Curgrid%nbvariables) 2020 2021 newvariable%pvar%var%root_var=>root_var%var 2022 2023 2024 End Subroutine Agrif_Declare_Variable 2025 2026 FUNCTION Agrif_Search_Variable(grid,varid) 2027 integer :: varid 2028 Type(Agrif_Pvariable), Pointer :: Agrif_Search_variable 2029 Type(Agrif_grid), Pointer :: grid 2030 2031 Type(Agrif_List_Variables), pointer :: parcours 2032 Logical :: foundvariable 2033 integer nb 2034 2035 foundvariable = .FALSE. 2036 parcours => grid%variables 2037 2038 do nb=1,varid-1 2039 parcours => parcours%nextvariable 2040 End Do 2041 2042 Agrif_Search_variable => parcours%pvar 2043 2044 2045 End Function Agrif_Search_variable 2046 2301 2302 2047 2303 Subroutine Agrif_Declare_Profile_flux(profilename,posvar, 2048 2304 & firstpoint,raf) … … 2071 2327 2072 2328 End Subroutine Agrif_Declare_Profile_flux 2329 2330 Subroutine Agrif_Save_ForRestore0D(tabvarsindic0,tabvarsindic) 2331 integer :: tabvarsindic0, tabvarsindic 2332 integer :: dimensio 2073 2333 2334 dimensio = Agrif_Mygrid % tabvars(tabvarsindic0) % var % nbdim 2335 2336 select case(dimensio) 2337 case(2) 2338 call Agrif_Save_ForRestore2D( 2339 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array2, 2340 & tabvarsindic) 2341 case(3) 2342 call Agrif_Save_ForRestore3D( 2343 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array3, 2344 & tabvarsindic) 2345 case(4) 2346 call Agrif_Save_ForRestore4D( 2347 & Agrif_Curgrid % tabvars(tabvarsindic0) % var % array4, 2348 & tabvarsindic) 2349 end select 2350 2351 Return 2352 End Subroutine Agrif_Save_ForRestore0D 2353 2354 2355 2356 Subroutine Agrif_Save_ForRestore2D(q,tabvarsindic) 2357 real,dimension(:,:) :: q 2358 integer :: tabvarsindic, indic 2359 TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars 2360 2361 indic = tabvarsindic 2362 if (tabvarsindic >=0) then 2363 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 2364 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 2365 endif 2366 endif 2367 2368 if (indic <=0) then 2369 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 2370 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 2371 else 2372 tabvars=>Agrif_Curgrid % tabvars(indic) 2373 roottabvars => Agrif_Mygrid % tabvars(indic) 2374 endif 2375 if (.not.allocated(tabvars%var%array2)) then 2376 allocate(tabvars%var%array2(tabvars%var%lb(1):tabvars%var%ub(1), 2377 & tabvars%var%lb(2):tabvars%var%ub(2))) 2378 endif 2379 tabvars%var%array2 = q 2380 roottabvars%var%restaure = .true. 2381 2382 Return 2383 End Subroutine Agrif_Save_ForRestore2D 2384 2385 Subroutine Agrif_Save_ForRestore3D(q,tabvarsindic) 2386 real,dimension(:,:,:) :: q 2387 integer :: tabvarsindic, indic 2388 TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars 2389 2390 indic = tabvarsindic 2391 if (tabvarsindic >=0) then 2392 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 2393 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 2394 endif 2395 endif 2396 2397 if (indic <=0) then 2398 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 2399 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 2400 else 2401 tabvars=>Agrif_Curgrid % tabvars(indic) 2402 roottabvars => Agrif_Mygrid % tabvars(indic) 2403 endif 2404 2405 if (.not.allocated(tabvars%var%array3)) then 2406 allocate(tabvars%var%array3(tabvars%var%lb(1):tabvars%var%ub(1), 2407 & tabvars%var%lb(2):tabvars%var%ub(2), 2408 & tabvars%var%lb(3):tabvars%var%ub(3))) 2409 endif 2410 tabvars%var%array3 = q 2411 roottabvars%var%restaure = .true. 2412 2413 Return 2414 End Subroutine Agrif_Save_ForRestore3D 2415 2416 Subroutine Agrif_Save_ForRestore4D(q,tabvarsindic) 2417 real,dimension(:,:,:,:) :: q 2418 integer :: tabvarsindic, indic 2419 TYPE(Agrif_PVariable),Pointer ::tabvars, roottabvars 2420 2421 indic = tabvarsindic 2422 if (tabvarsindic >=0) then 2423 if (agrif_curgrid%tabvars(tabvarsindic)%var%nbdim == 0) then 2424 indic = agrif_curgrid%tabvars(tabvarsindic)%var%iarray0 2425 endif 2426 endif 2427 2428 if (indic <=0) then 2429 tabvars => Agrif_Search_Variable(Agrif_Curgrid,-indic) 2430 roottabvars => Agrif_Search_Variable(Agrif_Mygrid,-indic) 2431 else 2432 tabvars=>Agrif_Curgrid % tabvars(indic) 2433 roottabvars => Agrif_Mygrid % tabvars(indic) 2434 endif 2435 2436 if (.not.allocated(tabvars%var%array4)) then 2437 allocate(tabvars%var%array4(tabvars%var%lb(1):tabvars%var%ub(1), 2438 & tabvars%var%lb(2):tabvars%var%ub(2), 2439 & tabvars%var%lb(3):tabvars%var%ub(3), 2440 & tabvars%var%lb(4):tabvars%var%ub(4))) 2441 endif 2442 tabvars%var%array4 = q 2443 roottabvars%var%restaure = .true. 2444 2445 Return 2446 End Subroutine Agrif_Save_ForRestore4D 2074 2447 C 2075 2448 End module Agrif_bcfunction -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcluster.F
r2528 r2673 1166 1166 C 1167 1167 newgrid % parent => g 1168 1169 C Level of the current grid 1170 newgrid % level = newgrid % parent % level + 1 1171 if (newgrid % level > Agrif_MaxLevelLoc) then 1172 Agrif_MaxLevelLoc = newgrid%level 1173 endif 1174 1168 1175 C 1169 1176 C Grid pointed by newgrid is a fixed grid -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modcurgridfunctions.F
r2528 r2673 684 684 685 685 C 686 C 687 A GRIF_saveCURGRID => AGRIF_CURGRID688 C 689 Call A GRIF_INSTANCE(AGRIF_CURGRID%parent)686 687 Agrif_Curgrid%Parent%save_grid => Agrif_Curgrid 688 C 689 Call Agrif_Instance(Agrif_Curgrid%parent) 690 690 C 691 691 C … … 709 709 C 710 710 C 711 Call A GRIF_INSTANCE(AGRIF_saveCURGRID)711 Call Agrif_Instance(Agrif_Curgrid%save_grid) 712 712 C 713 713 C … … 737 737 INTEGER :: iii,out,iiimax 738 738 Logical :: BEXIST 739 INTEGER,DIMENSION(1:10 ) :: ForbiddenUnit739 INTEGER,DIMENSION(1:1000) :: ForbiddenUnit 740 740 C 741 741 C … … 967 967 MaxSearch = mymaxsearch 968 968 end subroutine Agrif_Set_MaskMaxSearch 969 970 C ***************************************************************** 971 CCC subroutine Agrif_Level 972 C ***************************************************************** 973 Function Agrif_Level() 974 Integer :: Agrif_Level 975 976 Agrif_Level = Agrif_Curgrid % level 977 978 End Function Agrif_Level 979 980 C ***************************************************************** 981 CCC subroutine Agrif_MaxLevel 982 C ***************************************************************** 983 Function Agrif_MaxLevel() 984 Integer :: Agrif_MaxLevel 985 986 Agrif_MaxLevel = Agrif_MaxLevelLoc 987 988 End Function Agrif_MaxLevel 969 989 970 990 End Module Agrif_CurgridFunctions -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinit.F
r2528 r2673 135 135 Agrif_Gr % tabvars(i) % var % nbdim = 0 136 136 C 137 if (a ssociated(Agrif_Gr%tabvars(i)%var%array1)) then137 if (allocated(Agrif_Gr%tabvars(i)%var%array1)) then 138 138 Agrif_Gr % tabvars(i) % var % nbdim = 1 139 139 Agrif_Gr % tabvars(i) % var % lb(1:1) = … … 142 142 & ubound(Agrif_Gr%tabvars(i)%var%array1) 143 143 endif 144 if (a ssociated(Agrif_Gr%tabvars(i)%var%array2)) then144 if (allocated(Agrif_Gr%tabvars(i)%var%array2)) then 145 145 Agrif_Gr % tabvars(i) % var % nbdim = 2 146 146 Agrif_Gr % tabvars(i) % var % lb(1:2) = … … 149 149 & ubound(Agrif_Gr%tabvars(i)%var%array2) 150 150 endif 151 if (a ssociated(Agrif_Gr%tabvars(i)%var%array3)) then151 if (allocated(Agrif_Gr%tabvars(i)%var%array3)) then 152 152 Agrif_Gr % tabvars(i) % var % nbdim = 3 153 153 Agrif_Gr % tabvars(i) % var % lb(1:3) = … … 156 156 & ubound(Agrif_Gr%tabvars(i)%var%array3) 157 157 endif 158 if (a ssociated(Agrif_Gr%tabvars(i)%var%array4)) then158 if (allocated(Agrif_Gr%tabvars(i)%var%array4)) then 159 159 Agrif_Gr % tabvars(i) % var % nbdim = 4 160 160 Agrif_Gr % tabvars(i) % var % lb(1:4) = … … 163 163 & ubound(Agrif_Gr%tabvars(i)%var%array4) 164 164 endif 165 if (a ssociated(Agrif_Gr%tabvars(i)%var%array5)) then165 if (allocated(Agrif_Gr%tabvars(i)%var%array5)) then 166 166 Agrif_Gr % tabvars(i) % var % nbdim = 5 167 167 Agrif_Gr % tabvars(i) % var % lb(1:5) = … … 170 170 & ubound(Agrif_Gr%tabvars(i)%var%array5) 171 171 endif 172 if (a ssociated(Agrif_Gr%tabvars(i)%var%array6)) then172 if (allocated(Agrif_Gr%tabvars(i)%var%array6)) then 173 173 Agrif_Gr % tabvars(i) % var % nbdim = 6 174 174 Agrif_Gr % tabvars(i) % var % lb(1:6) = … … 178 178 endif 179 179 C 180 if (a ssociated(Agrif_Gr%tabvars(i)%var%darray1)) then181 Agrif_Gr % tabvars(i) % var % nbdim = 1 182 endif 183 if (a ssociated(Agrif_Gr%tabvars(i)%var%darray2)) then184 Agrif_Gr % tabvars(i) % var % nbdim = 2 185 endif 186 if (a ssociated(Agrif_Gr%tabvars(i)%var%darray3)) then187 Agrif_Gr % tabvars(i) % var % nbdim = 3 188 endif 189 if (a ssociated(Agrif_Gr%tabvars(i)%var%darray4)) then190 Agrif_Gr % tabvars(i) % var % nbdim = 4 191 endif 192 if (a ssociated(Agrif_Gr%tabvars(i)%var%darray5)) then193 Agrif_Gr % tabvars(i) % var % nbdim = 5 194 endif 195 if (a ssociated(Agrif_Gr%tabvars(i)%var%darray6)) then196 Agrif_Gr % tabvars(i) % var % nbdim = 6 197 endif 198 C 199 if (a ssociated(Agrif_Gr%tabvars(i)%var%larray1)) then200 Agrif_Gr % tabvars(i) % var % nbdim = 1 201 endif 202 if (a ssociated(Agrif_Gr%tabvars(i)%var%larray2)) then203 Agrif_Gr % tabvars(i) % var % nbdim = 2 204 endif 205 if (a ssociated(Agrif_Gr%tabvars(i)%var%larray3)) then206 Agrif_Gr % tabvars(i) % var % nbdim = 3 207 endif 208 if (a ssociated(Agrif_Gr%tabvars(i)%var%larray4)) then209 Agrif_Gr % tabvars(i) % var % nbdim = 4 210 endif 211 if (a ssociated(Agrif_Gr%tabvars(i)%var%larray5)) then212 Agrif_Gr % tabvars(i) % var % nbdim = 5 213 endif 214 if (a ssociated(Agrif_Gr%tabvars(i)%var%larray6)) then215 Agrif_Gr % tabvars(i) % var % nbdim = 6 216 endif 217 C 218 if (a ssociated(Agrif_Gr%tabvars(i)%var%iarray1)) then219 Agrif_Gr % tabvars(i) % var % nbdim = 1 220 endif 221 if (a ssociated(Agrif_Gr%tabvars(i)%var%iarray2)) then222 Agrif_Gr % tabvars(i) % var % nbdim = 2 223 endif 224 if (a ssociated(Agrif_Gr%tabvars(i)%var%iarray3)) then225 Agrif_Gr % tabvars(i) % var % nbdim = 3 226 endif 227 if (a ssociated(Agrif_Gr%tabvars(i)%var%iarray4)) then228 Agrif_Gr % tabvars(i) % var % nbdim = 4 229 endif 230 if (a ssociated(Agrif_Gr%tabvars(i)%var%iarray5)) then231 Agrif_Gr % tabvars(i) % var % nbdim = 5 232 endif 233 if (a ssociated(Agrif_Gr%tabvars(i)%var%iarray6)) then234 Agrif_Gr % tabvars(i) % var % nbdim = 6 235 endif 236 C 237 if (a ssociated(Agrif_Gr%tabvars(i)%var%carray1)) then238 Agrif_Gr % tabvars(i) % var % nbdim = 1 239 endif 240 if (a ssociated(Agrif_Gr%tabvars(i)%var%carray2)) then180 if (allocated(Agrif_Gr%tabvars(i)%var%darray1)) then 181 Agrif_Gr % tabvars(i) % var % nbdim = 1 182 endif 183 if (allocated(Agrif_Gr%tabvars(i)%var%darray2)) then 184 Agrif_Gr % tabvars(i) % var % nbdim = 2 185 endif 186 if (allocated(Agrif_Gr%tabvars(i)%var%darray3)) then 187 Agrif_Gr % tabvars(i) % var % nbdim = 3 188 endif 189 if (allocated(Agrif_Gr%tabvars(i)%var%darray4)) then 190 Agrif_Gr % tabvars(i) % var % nbdim = 4 191 endif 192 if (allocated(Agrif_Gr%tabvars(i)%var%darray5)) then 193 Agrif_Gr % tabvars(i) % var % nbdim = 5 194 endif 195 if (allocated(Agrif_Gr%tabvars(i)%var%darray6)) then 196 Agrif_Gr % tabvars(i) % var % nbdim = 6 197 endif 198 C 199 if (allocated(Agrif_Gr%tabvars(i)%var%larray1)) then 200 Agrif_Gr % tabvars(i) % var % nbdim = 1 201 endif 202 if (allocated(Agrif_Gr%tabvars(i)%var%larray2)) then 203 Agrif_Gr % tabvars(i) % var % nbdim = 2 204 endif 205 if (allocated(Agrif_Gr%tabvars(i)%var%larray3)) then 206 Agrif_Gr % tabvars(i) % var % nbdim = 3 207 endif 208 if (allocated(Agrif_Gr%tabvars(i)%var%larray4)) then 209 Agrif_Gr % tabvars(i) % var % nbdim = 4 210 endif 211 if (allocated(Agrif_Gr%tabvars(i)%var%larray5)) then 212 Agrif_Gr % tabvars(i) % var % nbdim = 5 213 endif 214 if (allocated(Agrif_Gr%tabvars(i)%var%larray6)) then 215 Agrif_Gr % tabvars(i) % var % nbdim = 6 216 endif 217 C 218 if (allocated(Agrif_Gr%tabvars(i)%var%iarray1)) then 219 Agrif_Gr % tabvars(i) % var % nbdim = 1 220 endif 221 if (allocated(Agrif_Gr%tabvars(i)%var%iarray2)) then 222 Agrif_Gr % tabvars(i) % var % nbdim = 2 223 endif 224 if (allocated(Agrif_Gr%tabvars(i)%var%iarray3)) then 225 Agrif_Gr % tabvars(i) % var % nbdim = 3 226 endif 227 if (allocated(Agrif_Gr%tabvars(i)%var%iarray4)) then 228 Agrif_Gr % tabvars(i) % var % nbdim = 4 229 endif 230 if (allocated(Agrif_Gr%tabvars(i)%var%iarray5)) then 231 Agrif_Gr % tabvars(i) % var % nbdim = 5 232 endif 233 if (allocated(Agrif_Gr%tabvars(i)%var%iarray6)) then 234 Agrif_Gr % tabvars(i) % var % nbdim = 6 235 endif 236 C 237 if (allocated(Agrif_Gr%tabvars(i)%var%carray1)) then 238 Agrif_Gr % tabvars(i) % var % nbdim = 1 239 endif 240 if (allocated(Agrif_Gr%tabvars(i)%var%carray2)) then 241 241 Agrif_Gr % tabvars(i) % var % nbdim = 2 242 242 endif -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterp.F
r2528 r2673 89 89 C 90 90 C Tab is the result of the interpolation 91 childtemp % var % array1 => tab91 childtemp % var % parray1 => tab 92 92 93 93 childtemp % var % lb = child % var % lb … … 97 97 if (torestore) then 98 98 C 99 childtemp % var % array1 = child % var % array199 childtemp % var % parray1 = child % var % array1 100 100 C 101 101 childtemp % var % restore1D => child % var % restore1D … … 171 171 C 172 172 C Tab is the result of the interpolation 173 childtemp % var % array2 => tab173 childtemp % var % parray2 => tab 174 174 175 175 childtemp % var % lb = child % var % lb … … 179 179 if (torestore) then 180 180 C 181 childtemp % var % array2 = child % var % array2181 childtemp % var % parray2 = child % var % array2 182 182 C 183 183 childtemp % var % restore2D => child % var % restore2D … … 255 255 C 256 256 C Tab is the result of the interpolation 257 childtemp % var % array3 => tab257 childtemp % var % parray3 => tab 258 258 259 259 childtemp % var % lb = child % var % lb … … 262 262 if (torestore) then 263 263 C 264 childtemp % var % array3 = child % var % array3264 childtemp % var % parray3 = child % var % array3 265 265 C 266 266 childtemp % var % restore3D => child % var % restore3D … … 341 341 C 342 342 C Tab is the result of the interpolation 343 childtemp % var % array4 => tab343 childtemp % var % parray4 => tab 344 344 345 345 childtemp % var % lb = child % var % lb … … 349 349 if (torestore) then 350 350 C 351 childtemp % var % array4 = child % var % array4351 childtemp % var % parray4 = child % var % array4 352 352 C 353 353 childtemp % var % restore4D => child % var % restore4D … … 428 428 C 429 429 C Tab is the result of the interpolation 430 childtemp % var % array5 => tab430 childtemp % var % parray5 => tab 431 431 432 432 childtemp % var % lb = child % var % lb … … 436 436 if (torestore) then 437 437 C 438 childtemp % var % array5 = child % var % array5438 childtemp % var % parray5 = child % var % array5 439 439 C 440 440 childtemp % var % restore5D => child % var % restore5D … … 516 516 C 517 517 C Tab is the result of the interpolation 518 childtemp % var % array6 => tab518 childtemp % var % parray6 => tab 519 519 520 520 childtemp % var % lb = child % var % lb … … 524 524 if (torestore) then 525 525 C 526 childtemp % var % array6 = child % var % array6526 childtemp % var % parray6 = child % var % array6 527 527 C 528 528 childtemp % var % restore6D => child % var % restore6D … … 835 835 836 836 Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim) 837 838 839 837 840 838 IF (present(procname)) THEN … … 894 892 C 895 893 Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim, 896 & MPI_INTEGER,MPI_COMM_ AGRIF,code)894 & MPI_INTEGER,MPI_COMM_WORLD,code) 897 895 898 896 IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var) … … 908 906 memberin1(1) = memberin 909 907 CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 910 & 1,MPI_LOGICAL,MPI_COMM_ AGRIF,code)908 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 911 909 912 910 Call Get_External_Data_first(tab4t(:,:,1), … … 1161 1159 do i = pttruetab(1),cetruetab(1) 1162 1160 if (restore%var%restore1D(i) == 0) 1163 & child % var % array1(i) =1161 & child % var % parray1(i) = 1164 1162 & tempC % var % array1(i) 1165 1163 enddo … … 1168 1166 do i = pttruetab(1),cetruetab(1) 1169 1167 if (restore%var%restore2D(i,j) == 0) 1170 & child % var % array2(i,j) =1168 & child % var % parray2(i,j) = 1171 1169 & tempC % var % array2(i,j) 1172 1170 enddo … … 1177 1175 do i = pttruetab(1),cetruetab(1) 1178 1176 if (restore%var%restore3D(i,j,k) == 0) 1179 & child % var % array3(i,j,k) =1177 & child % var % parray3(i,j,k) = 1180 1178 & tempC % var % array3(i,j,k) 1181 1179 enddo … … 1188 1186 do i = pttruetab(1),cetruetab(1) 1189 1187 if (restore%var%restore4D(i,j,k,l) == 0) 1190 & child % var % array4(i,j,k,l) =1188 & child % var % parray4(i,j,k,l) = 1191 1189 & tempC % var % array4(i,j,k,l) 1192 1190 enddo … … 1201 1199 do i = pttruetab(1),cetruetab(1) 1202 1200 if (restore%var%restore5D(i,j,k,l,m) == 0) 1203 & child % var % array5(i,j,k,l,m) =1201 & child % var % parray5(i,j,k,l,m) = 1204 1202 & tempC % var % array5(i,j,k,l,m) 1205 1203 enddo … … 1216 1214 do i = pttruetab(1),cetruetab(1) 1217 1215 if (restore%var%restore6D(i,j,k,l,m,n) == 0) 1218 & child % var % array6(i,j,k,l,m,n) =1216 & child % var % parray6(i,j,k,l,m,n) = 1219 1217 & tempC % var % array6(i,j,k,l,m,n) 1220 1218 enddo … … 1234 1232 SELECT CASE (nbdim) 1235 1233 CASE (1) 1236 child%var% array1(childarray(1,1,2):childarray(1,2,2)) =1234 child%var%parray1(childarray(1,1,2):childarray(1,2,2)) = 1237 1235 & tempC%var%array1(childarray(1,1,1):childarray(1,2,1)) 1238 1236 CASE (2) 1239 child%var% array2(childarray(1,1,2):childarray(1,2,2),1237 child%var%parray2(childarray(1,1,2):childarray(1,2,2), 1240 1238 & childarray(2,1,2):childarray(2,2,2)) = 1241 1239 & tempC%var%array2(childarray(1,1,1):childarray(1,2,1), 1242 1240 & childarray(2,1,1):childarray(2,2,1)) 1243 1241 CASE (3) 1244 child%var% array3(childarray(1,1,2):childarray(1,2,2),1242 child%var%parray3(childarray(1,1,2):childarray(1,2,2), 1245 1243 & childarray(2,1,2):childarray(2,2,2), 1246 1244 & childarray(3,1,2):childarray(3,2,2)) = … … 1249 1247 & childarray(3,1,1):childarray(3,2,1)) 1250 1248 CASE (4) 1251 child%var% array4(childarray(1,1,2):childarray(1,2,2),1249 child%var%parray4(childarray(1,1,2):childarray(1,2,2), 1252 1250 & childarray(2,1,2):childarray(2,2,2), 1253 1251 & childarray(3,1,2):childarray(3,2,2), … … 1258 1256 & childarray(4,1,1):childarray(4,2,1)) 1259 1257 CASE (5) 1260 child%var% array5(childarray(1,1,2):childarray(1,2,2),1258 child%var%parray5(childarray(1,1,2):childarray(1,2,2), 1261 1259 & childarray(2,1,2):childarray(2,2,2), 1262 1260 & childarray(3,1,2):childarray(3,2,2), … … 1269 1267 & childarray(5,1,1):childarray(5,2,1)) 1270 1268 CASE (6) 1271 child%var% array6(childarray(1,1,2):childarray(1,2,2),1269 child%var%parray6(childarray(1,1,2):childarray(1,2,2), 1272 1270 & childarray(2,1,2):childarray(2,2,2), 1273 1271 & childarray(3,1,2):childarray(3,2,2), -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modinterpbasic.F
r2528 r2673 113 113 locind_parent_left = locind_parent_left + 1. 114 114 globind_parent_right = globind_parent_right + 1. 115 ypos2 = ypos*invds+(i-1)*invds2 115 116 endif 116 117 117 118 diff=(globind_parent_right - ypos2) 118 119 119 y(i) = (diff*x(locind_parent_left) 120 120 & + (1.-diff)*x(locind_parent_left+1)) … … 170 170 Real, Dimension(:,:), Allocatable :: coeffparent_tmp 171 171 REAL :: ypos,globind_parent_left,globind_parent_right 172 REAL :: invds, invds2 172 REAL :: invds, invds2, invds3 173 173 REAL :: ypos2,diff 174 174 C … … 189 189 invds = 1./ds_parent 190 190 invds2 = ds_child/ds_parent 191 invds3 = 0.5/real(coeffraf) 191 192 192 193 ypos2 = ypos*invds … … 216 217 locind_parent_left = locind_parent_left + 1 217 218 globind_parent_right = globind_parent_right + 1. 219 ypos2 = ypos*invds+(i-1)*invds2 218 220 endif 219 221 220 222 diff=(globind_parent_right - ypos2) 223 diff = invds3*nint(2*coeffraf*diff) 221 224 indparent(i,dir) = locind_parent_left 225 222 226 coeffparent(i,dir) = diff 223 227 … … 238 242 C 239 243 indparent(nc,dir) = locind_parent_left 240 241 coeffparent(nc,dir) = (globind_parent_left + ds_parent - ypos) 244 diff = (globind_parent_left + ds_parent - ypos) 242 245 & * invds 246 diff = invds3*nint(2*coeffraf*diff) 247 coeffparent(nc,dir) = diff 243 248 endif 244 249 … … 280 285 INTEGER :: i,coeffraf,locind_parent_left 281 286 REAL :: ypos,globind_parent_left,globind_parent_right 282 REAL :: invds, invds2 287 REAL :: invds, invds2, invds3 283 288 REAL :: ypos2,diff 284 289 C … … 305 310 invds = 1./ds_parent 306 311 invds2 = ds_child/ds_parent 312 invds3 = 0.5/real(coeffraf) 307 313 308 314 ypos2 = ypos*invds … … 323 329 locind_parent_left = locind_parent_left + 1 324 330 globind_parent_right = globind_parent_right + 1. 331 ypos2 = ypos*invds+(i-1)*invds2 325 332 endif 326 333 327 334 diff=(globind_parent_right - ypos2) 335 336 diff = invds3*nint(2*coeffraf*diff) 337 328 338 indparent(i,1) = locind_parent_left 339 329 340 coeffparent(i,1) = diff 330 341 ypos2 = ypos2 + invds2 … … 345 356 indparent(nc,1) = locind_parent_left 346 357 347 coeffparent(nc,1)= (globind_parent_left + ds_parent - ypos)358 diff = (globind_parent_left + ds_parent - ypos) 348 359 & * invds 360 diff = invds3*nint(2*coeffraf*diff) 361 coeffparent(nc,1) = diff 349 362 endif 350 363 C … … 462 475 & + (locind_parent_left - 1)*ds_parent 463 476 464 deltax = invdsparent*(ypos-globind_parent_left) 477 C deltax = invdsparent*(ypos-globind_parent_left) 478 deltax = nint(coeffraf*deltax)/real(coeffraf) 479 465 480 ypos = ypos + ds_child 466 481 if (abs(deltax).LE.0.0001) then -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modlinktomodel.F
r2528 r2673 32 32 external Agrif_probdim_modtype_def 33 33 external Agrif_clustering_def 34 external Agrif_comm_def35 34 C Interface 36 35 Interface -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modmpp.F
r2528 r2673 67 67 68 68 CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall, 69 & 1,MPI_LOGICAL,MPI_COMM_ AGRIF,code)69 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 70 70 ENDIF 71 71 pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank) … … 207 207 208 208 CALL MPI_ALLGATHER(memberout1,1,MPI_LOGICAL,memberoutall, 209 & 1,MPI_LOGICAL,MPI_COMM_ AGRIF,code)209 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 210 210 ENDIF 211 211 pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank) … … 356 356 C 357 357 Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 358 & MPI_COMM_ AGRIF,code)358 & MPI_COMM_WORLD,code) 359 359 C 360 360 if (sendtoproc(k)) then … … 365 365 Call MPI_SEND(iminmax_temp(:,:,k), 366 366 & 2*nbdim,MPI_INTEGER,k,etiquette, 367 & MPI_COMM_ AGRIF,code)367 & MPI_COMM_WORLD,code) 368 368 C 369 369 datasize = 1 … … 381 381 & imin(1,k):imax(1,k)), 382 382 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 383 & MPI_COMM_ AGRIF,code)383 & MPI_COMM_WORLD,code) 384 384 CASE(2) 385 385 Call MPI_SEND(tempC%var%array2( … … 387 387 & imin(2,k):imax(2,k)), 388 388 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 389 & MPI_COMM_ AGRIF,code)389 & MPI_COMM_WORLD,code) 390 390 CASE(3) 391 391 … … 399 399 & imin(4,k):imax(4,k)), 400 400 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 401 & MPI_COMM_ AGRIF,code)401 & MPI_COMM_WORLD,code) 402 402 CASE(5) 403 403 Call MPI_SEND(tempC%var%array5( … … 408 408 & imin(5,k):imax(5,k)), 409 409 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 410 & MPI_COMM_ AGRIF,code)410 & MPI_COMM_WORLD,code) 411 411 CASE(6) 412 412 Call MPI_SEND(tempC%var%array6( … … 418 418 & imin(6,k):imax(6,k)), 419 419 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 420 & MPI_COMM_ AGRIF,code)420 & MPI_COMM_WORLD,code) 421 421 END SELECT 422 422 C … … 432 432 C 433 433 Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 434 & MPI_COMM_ AGRIF,statut,code)434 & MPI_COMM_WORLD,statut,code) 435 435 C 436 436 recvfromproc(k) = res … … 441 441 Call MPI_RECV(iminmax_temp(:,:,k), 442 442 & 2*nbdim,MPI_INTEGER,k,etiquette, 443 & MPI_COMM_ AGRIF,statut,code)443 & MPI_COMM_WORLD,statut,code) 444 444 445 445 imin_recv(:,k) = iminmax_temp(:,1,k) … … 462 462 Call MPI_RECV(temprecv%var%array1, 463 463 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 464 & MPI_COMM_ AGRIF,statut,code)464 & MPI_COMM_WORLD,statut,code) 465 465 CASE(2) 466 466 Call MPI_RECV(temprecv%var%array2, 467 467 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 468 & MPI_COMM_ AGRIF,statut,code)468 & MPI_COMM_WORLD,statut,code) 469 469 CASE(3) 470 470 Call MPI_RECV(temprecv%var%array3, 471 471 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 472 & MPI_COMM_ AGRIF,statut,code)472 & MPI_COMM_WORLD,statut,code) 473 473 474 474 CASE(4) 475 475 Call MPI_RECV(temprecv%var%array4, 476 476 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 477 & MPI_COMM_ AGRIF,statut,code)477 & MPI_COMM_WORLD,statut,code) 478 478 CASE(5) 479 479 Call MPI_RECV(temprecv%var%array5, 480 480 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 481 & MPI_COMM_ AGRIF,statut,code)481 & MPI_COMM_WORLD,statut,code) 482 482 CASE(6) 483 483 Call MPI_RECV(temprecv%var%array6, 484 484 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 485 & MPI_COMM_ AGRIF,statut,code)485 & MPI_COMM_WORLD,statut,code) 486 486 END SELECT 487 487 … … 503 503 504 504 Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 505 & MPI_COMM_ AGRIF,code)505 & MPI_COMM_WORLD,code) 506 506 C 507 507 if (sendtoproc(k)) then … … 512 512 Call MPI_SEND(iminmax_temp(:,:,k), 513 513 & 2*nbdim,MPI_INTEGER,k,etiquette, 514 & MPI_COMM_ AGRIF,code)514 & MPI_COMM_WORLD,code) 515 515 C 516 516 SELECT CASE(nbdim) … … 521 521 & imin(1,k):imax(1,k)), 522 522 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 523 & MPI_COMM_ AGRIF,code)523 & MPI_COMM_WORLD,code) 524 524 CASE(2) 525 525 datasize=SIZE(tempC%var%array2( … … 530 530 & imin(2,k):imax(2,k)), 531 531 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 532 & MPI_COMM_ AGRIF,code)532 & MPI_COMM_WORLD,code) 533 533 CASE(3) 534 534 datasize=SIZE(tempC%var%array3( … … 541 541 & imin(3,k):imax(3,k)), 542 542 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 543 & MPI_COMM_ AGRIF,code)543 & MPI_COMM_WORLD,code) 544 544 CASE(4) 545 545 datasize=SIZE(tempC%var%array4( … … 554 554 & imin(4,k):imax(4,k)), 555 555 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 556 & MPI_COMM_ AGRIF,code)556 & MPI_COMM_WORLD,code) 557 557 CASE(5) 558 558 datasize=SIZE(tempC%var%array5( … … 569 569 & imin(5,k):imax(5,k)), 570 570 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 571 & MPI_COMM_ AGRIF,code)571 & MPI_COMM_WORLD,code) 572 572 CASE(6) 573 573 datasize=SIZE(tempC%var%array6( … … 586 586 & imin(6,k):imax(6,k)), 587 587 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 588 & MPI_COMM_ AGRIF,code)588 & MPI_COMM_WORLD,code) 589 589 END SELECT 590 590 C … … 600 600 C 601 601 Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 602 & MPI_COMM_ AGRIF,statut,code)602 & MPI_COMM_WORLD,statut,code) 603 603 C 604 604 recvfromproc(k) = res … … 609 609 Call MPI_RECV(iminmax_temp(:,:,k), 610 610 & 2*nbdim,MPI_INTEGER,k,etiquette, 611 & MPI_COMM_ AGRIF,statut,code)611 & MPI_COMM_WORLD,statut,code) 612 612 613 613 C imin_recv(:,k) = iminmax_temp(:,1,k) … … 629 629 Call MPI_RECV(temprecv%var%array1, 630 630 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 631 & MPI_COMM_ AGRIF,statut,code)631 & MPI_COMM_WORLD,statut,code) 632 632 CASE(2) 633 633 datasize=SIZE(temprecv%var%array2) 634 634 Call MPI_RECV(temprecv%var%array2, 635 635 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 636 & MPI_COMM_ AGRIF,statut,code)636 & MPI_COMM_WORLD,statut,code) 637 637 CASE(3) 638 638 datasize=SIZE(temprecv%var%array3) 639 639 Call MPI_RECV(temprecv%var%array3, 640 640 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 641 & MPI_COMM_ AGRIF,statut,code)641 & MPI_COMM_WORLD,statut,code) 642 642 643 643 CASE(4) … … 645 645 Call MPI_RECV(temprecv%var%array4, 646 646 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 647 & MPI_COMM_ AGRIF,statut,code)647 & MPI_COMM_WORLD,statut,code) 648 648 CASE(5) 649 649 datasize=SIZE(temprecv%var%array5) 650 650 Call MPI_RECV(temprecv%var%array5, 651 651 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 652 & MPI_COMM_ AGRIF,statut,code)652 & MPI_COMM_WORLD,statut,code) 653 653 CASE(6) 654 654 datasize=SIZE(temprecv%var%array6) 655 655 Call MPI_RECV(temprecv%var%array6, 656 656 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 657 & MPI_COMM_ AGRIF,statut,code)657 & MPI_COMM_WORLD,statut,code) 658 658 END SELECT 659 659 … … 693 693 C 694 694 Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 695 & MPI_COMM_ AGRIF,code)695 & MPI_COMM_WORLD,code) 696 696 C 697 697 if (sendtoproc(k)) then … … 702 702 Call MPI_SEND(iminmax_temp(:,:,k), 703 703 & 2*nbdim,MPI_INTEGER,k,etiquette, 704 & MPI_COMM_ AGRIF,code)704 & MPI_COMM_WORLD,code) 705 705 C 706 706 endif … … 715 715 C 716 716 Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 717 & MPI_COMM_ AGRIF,statut,code)717 & MPI_COMM_WORLD,statut,code) 718 718 C 719 719 recvfromproc(k) = res … … 724 724 Call MPI_RECV(iminmax_temp(:,:,k), 725 725 & 2*nbdim,MPI_INTEGER,k,etiquette, 726 & MPI_COMM_ AGRIF,statut,code)726 & MPI_COMM_WORLD,statut,code) 727 727 728 728 imin_recv(:,k) = iminmax_temp(:,1,k) … … 739 739 740 740 Call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette, 741 & MPI_COMM_ AGRIF,code)741 & MPI_COMM_WORLD,code) 742 742 C 743 743 if (sendtoproc(k)) then … … 748 748 Call MPI_SEND(iminmax_temp(:,:,k), 749 749 & 2*nbdim,MPI_INTEGER,k,etiquette, 750 & MPI_COMM_ AGRIF,code)750 & MPI_COMM_WORLD,code) 751 751 C 752 752 endif … … 761 761 C 762 762 Call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette, 763 & MPI_COMM_ AGRIF,statut,code)763 & MPI_COMM_WORLD,statut,code) 764 764 C 765 765 recvfromproc(k) = res … … 770 770 Call MPI_RECV(iminmax_temp(:,:,k), 771 771 & 2*nbdim,MPI_INTEGER,k,etiquette, 772 & MPI_COMM_ AGRIF,statut,code)772 & MPI_COMM_WORLD,statut,code) 773 773 774 774 imin_recv(:,k) = iminmax_temp(:,1,k) … … 842 842 & imin(1,k):imax(1,k)), 843 843 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 844 & MPI_COMM_ AGRIF,code)844 & MPI_COMM_WORLD,code) 845 845 CASE(2) 846 846 Call MPI_SEND(tempC%var%array2( … … 848 848 & imin(2,k):imax(2,k)), 849 849 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 850 & MPI_COMM_ AGRIF,code)850 & MPI_COMM_WORLD,code) 851 851 CASE(3) 852 852 … … 860 860 & imin(4,k):imax(4,k)), 861 861 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 862 & MPI_COMM_ AGRIF,code)862 & MPI_COMM_WORLD,code) 863 863 CASE(5) 864 864 Call MPI_SEND(tempC%var%array5( … … 869 869 & imin(5,k):imax(5,k)), 870 870 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 871 & MPI_COMM_ AGRIF,code)871 & MPI_COMM_WORLD,code) 872 872 CASE(6) 873 873 Call MPI_SEND(tempC%var%array6( … … 879 879 & imin(6,k):imax(6,k)), 880 880 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 881 & MPI_COMM_ AGRIF,code)881 & MPI_COMM_WORLD,code) 882 882 END SELECT 883 883 C … … 910 910 Call MPI_RECV(temprecv%var%array1, 911 911 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 912 & MPI_COMM_ AGRIF,statut,code)912 & MPI_COMM_WORLD,statut,code) 913 913 CASE(2) 914 914 Call MPI_RECV(temprecv%var%array2, 915 915 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 916 & MPI_COMM_ AGRIF,statut,code)916 & MPI_COMM_WORLD,statut,code) 917 917 CASE(3) 918 918 Call MPI_RECV(temprecv%var%array3, 919 919 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 920 & MPI_COMM_ AGRIF,statut,code)920 & MPI_COMM_WORLD,statut,code) 921 921 922 922 CASE(4) 923 923 Call MPI_RECV(temprecv%var%array4, 924 924 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 925 & MPI_COMM_ AGRIF,statut,code)925 & MPI_COMM_WORLD,statut,code) 926 926 CASE(5) 927 927 Call MPI_RECV(temprecv%var%array5, 928 928 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 929 & MPI_COMM_ AGRIF,statut,code)929 & MPI_COMM_WORLD,statut,code) 930 930 CASE(6) 931 931 Call MPI_RECV(temprecv%var%array6, 932 932 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 933 & MPI_COMM_ AGRIF,statut,code)933 & MPI_COMM_WORLD,statut,code) 934 934 END SELECT 935 935 … … 958 958 & imin(1,k):imax(1,k)), 959 959 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 960 & MPI_COMM_ AGRIF,code)960 & MPI_COMM_WORLD,code) 961 961 CASE(2) 962 962 datasize=SIZE(tempC%var%array2( … … 967 967 & imin(2,k):imax(2,k)), 968 968 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 969 & MPI_COMM_ AGRIF,code)969 & MPI_COMM_WORLD,code) 970 970 CASE(3) 971 971 datasize=SIZE(tempC%var%array3( … … 978 978 & imin(3,k):imax(3,k)), 979 979 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 980 & MPI_COMM_ AGRIF,code)980 & MPI_COMM_WORLD,code) 981 981 CASE(4) 982 982 datasize=SIZE(tempC%var%array4( … … 991 991 & imin(4,k):imax(4,k)), 992 992 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 993 & MPI_COMM_ AGRIF,code)993 & MPI_COMM_WORLD,code) 994 994 CASE(5) 995 995 datasize=SIZE(tempC%var%array5( … … 1006 1006 & imin(5,k):imax(5,k)), 1007 1007 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1008 & MPI_COMM_ AGRIF,code)1008 & MPI_COMM_WORLD,code) 1009 1009 CASE(6) 1010 1010 datasize=SIZE(tempC%var%array6( … … 1023 1023 & imin(6,k):imax(6,k)), 1024 1024 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1025 & MPI_COMM_ AGRIF,code)1025 & MPI_COMM_WORLD,code) 1026 1026 END SELECT 1027 1027 C … … 1047 1047 Call MPI_RECV(temprecv%var%array1, 1048 1048 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1049 & MPI_COMM_ AGRIF,statut,code)1049 & MPI_COMM_WORLD,statut,code) 1050 1050 CASE(2) 1051 1051 datasize=SIZE(temprecv%var%array2) 1052 1052 Call MPI_RECV(temprecv%var%array2, 1053 1053 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1054 & MPI_COMM_ AGRIF,statut,code)1054 & MPI_COMM_WORLD,statut,code) 1055 1055 CASE(3) 1056 1056 datasize=SIZE(temprecv%var%array3) 1057 1057 Call MPI_RECV(temprecv%var%array3, 1058 1058 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1059 & MPI_COMM_ AGRIF,statut,code)1059 & MPI_COMM_WORLD,statut,code) 1060 1060 1061 1061 CASE(4) … … 1063 1063 Call MPI_RECV(temprecv%var%array4, 1064 1064 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1065 & MPI_COMM_ AGRIF,statut,code)1065 & MPI_COMM_WORLD,statut,code) 1066 1066 CASE(5) 1067 1067 datasize=SIZE(temprecv%var%array5) 1068 1068 Call MPI_RECV(temprecv%var%array5, 1069 1069 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1070 & MPI_COMM_ AGRIF,statut,code)1070 & MPI_COMM_WORLD,statut,code) 1071 1071 CASE(6) 1072 1072 datasize=SIZE(temprecv%var%array6) 1073 1073 Call MPI_RECV(temprecv%var%array6, 1074 1074 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1075 & MPI_COMM_ AGRIF,statut,code)1075 & MPI_COMM_WORLD,statut,code) 1076 1076 END SELECT 1077 1077 … … 1108 1108 & imin(3):imax(3)), 1109 1109 & datasize,MPI_DOUBLE_PRECISION,k,etiquette, 1110 & MPI_COMM_ AGRIF,code)1110 & MPI_COMM_WORLD,code) 1111 1111 1112 1112 End Subroutine Agrif_Send_3Darray -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modsauv.F
r2528 r2673 35 35 Use Agrif_Link 36 36 Use Agrif_Arrays 37 Use Agrif_Variables 37 38 C 38 39 IMPLICIT NONE … … 42 43 C 43 44 C 45 Subroutine Agrif_Deallocate_Arrays(Var) 46 type(Agrif_Variable), pointer :: Var 47 48 if (ALLOCATED(var%array1)) then 49 Deallocate(var%array1) 50 endif 51 if (ALLOCATED(var%array2)) then 52 Deallocate(var%array2) 53 endif 54 if (ALLOCATED(var%array3)) then 55 Deallocate(var%array3) 56 endif 57 if (ALLOCATED(var%array4)) then 58 Deallocate(var%array4) 59 endif 60 if (ALLOCATED(var%array5)) then 61 Deallocate(var%array5) 62 endif 63 if (ALLOCATED(var%array6)) then 64 Deallocate(var%array6) 65 endif 66 C 67 if (ALLOCATED(var%darray1)) then 68 Deallocate(var%darray1) 69 endif 70 if (ALLOCATED(var%darray2)) then 71 Deallocate(var%darray2) 72 endif 73 if (ALLOCATED(var%darray3)) then 74 Deallocate(var%darray3) 75 endif 76 if (ALLOCATED(var%darray4)) then 77 Deallocate(var%darray4) 78 endif 79 if (ALLOCATED(var%darray5)) then 80 Deallocate(var%darray5) 81 endif 82 if (ALLOCATED(var%darray6)) then 83 Deallocate(var%darray6) 84 endif 85 C 86 if (ALLOCATED(var%larray1)) then 87 Deallocate(var%larray1) 88 endif 89 if (ALLOCATED(var%larray2)) then 90 Deallocate(var%larray2) 91 endif 92 if (ALLOCATED(var%larray3)) then 93 Deallocate(var%larray3) 94 endif 95 if (ALLOCATED(var%larray4)) then 96 Deallocate(var%larray4) 97 endif 98 if (ALLOCATED(var%larray5)) then 99 Deallocate(var%larray5) 100 endif 101 if (ALLOCATED(var%larray6)) then 102 Deallocate(var%larray6) 103 endif 104 C 105 if (ALLOCATED(var%iarray1)) then 106 Deallocate(var%iarray1) 107 endif 108 if (ALLOCATED(var%iarray2)) then 109 Deallocate(var%iarray2) 110 endif 111 if (ALLOCATED(var%iarray3)) then 112 Deallocate(var%iarray3) 113 endif 114 if (ALLOCATED(var%iarray4)) then 115 Deallocate(var%iarray4) 116 endif 117 if (ALLOCATED(var%iarray5)) then 118 Deallocate(var%iarray5) 119 endif 120 if (ALLOCATED(var%iarray6)) then 121 Deallocate(var%iarray6) 122 endif 123 C 124 if (ALLOCATED(var%carray1)) then 125 Deallocate(var%carray1) 126 endif 127 if (ALLOCATED(var%carray2)) then 128 Deallocate(var%carray2) 129 endif 130 C 131 if (associated(var%oldvalues2D)) then 132 Deallocate(var%oldvalues2D) 133 endif 134 if (associated(var%interpIndex)) then 135 Deallocate(var%interpIndex) 136 endif 137 138 if (associated(var%posvar)) then 139 Deallocate(var%posvar) 140 endif 141 142 if (associated(var%interptab)) then 143 Deallocate(var%interptab) 144 endif 145 146 Return 147 End Subroutine Agrif_Deallocate_Arrays 44 148 C 45 149 C ************************************************************************** … … 62 166 TYPE(Agrif_Grid),pointer :: Agrif_Gr ! Pointer on the current grid 63 167 INTEGER i 168 Type(Agrif_List_Variables), pointer :: parcours 64 169 C 65 170 C … … 67 172 if ( .NOT. Agrif_Mygrid % tabvars(i) % var % restaure) then 68 173 C 69 if (associated(Agrif_Gr%tabvars(i)%var%array1)) then 70 Deallocate(Agrif_Gr%tabvars(i)%var%array1) 71 endif 72 if (associated(Agrif_Gr%tabvars(i)%var%array2)) then 73 Deallocate(Agrif_Gr%tabvars(i)%var%array2) 74 endif 75 if (associated(Agrif_Gr%tabvars(i)%var%array3)) then 76 Deallocate(Agrif_Gr%tabvars(i)%var%array3) 77 endif 78 if (associated(Agrif_Gr%tabvars(i)%var%array4)) then 79 Deallocate(Agrif_Gr%tabvars(i)%var%array4) 80 endif 81 if (associated(Agrif_Gr%tabvars(i)%var%array5)) then 82 Deallocate(Agrif_Gr%tabvars(i)%var%array5) 83 endif 84 if (associated(Agrif_Gr%tabvars(i)%var%array6)) then 85 Deallocate(Agrif_Gr%tabvars(i)%var%array6) 86 endif 87 C 88 if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then 89 Deallocate(Agrif_Gr%tabvars(i)%var%darray1) 90 endif 91 if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then 92 Deallocate(Agrif_Gr%tabvars(i)%var%darray2) 93 endif 94 if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then 95 Deallocate(Agrif_Gr%tabvars(i)%var%darray3) 96 endif 97 if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then 98 Deallocate(Agrif_Gr%tabvars(i)%var%darray4) 99 endif 100 if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then 101 Deallocate(Agrif_Gr%tabvars(i)%var%darray5) 102 endif 103 if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then 104 Deallocate(Agrif_Gr%tabvars(i)%var%darray6) 105 endif 106 C 107 if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then 108 Deallocate(Agrif_Gr%tabvars(i)%var%larray1) 109 endif 110 if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then 111 Deallocate(Agrif_Gr%tabvars(i)%var%larray2) 112 endif 113 if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then 114 Deallocate(Agrif_Gr%tabvars(i)%var%larray3) 115 endif 116 if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then 117 Deallocate(Agrif_Gr%tabvars(i)%var%larray4) 118 endif 119 if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then 120 Deallocate(Agrif_Gr%tabvars(i)%var%larray5) 121 endif 122 if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then 123 Deallocate(Agrif_Gr%tabvars(i)%var%larray6) 124 endif 125 C 126 if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then 127 Deallocate(Agrif_Gr%tabvars(i)%var%iarray1) 128 endif 129 if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then 130 Deallocate(Agrif_Gr%tabvars(i)%var%iarray2) 131 endif 132 if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then 133 Deallocate(Agrif_Gr%tabvars(i)%var%iarray3) 134 endif 135 if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then 136 Deallocate(Agrif_Gr%tabvars(i)%var%iarray4) 137 endif 138 if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then 139 Deallocate(Agrif_Gr%tabvars(i)%var%iarray5) 140 endif 141 if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then 142 Deallocate(Agrif_Gr%tabvars(i)%var%iarray6) 143 endif 144 C 145 if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then 146 Deallocate(Agrif_Gr%tabvars(i)%var%carray1) 147 endif 148 if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then 149 Deallocate(Agrif_Gr%tabvars(i)%var%carray2) 150 endif 151 C 152 if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then 153 Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D) 154 endif 155 if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then 156 Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex) 157 endif 158 159 if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 160 Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 161 endif 162 163 if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 164 Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 165 endif 174 call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 166 175 167 176 endif … … 177 186 C 178 187 endif 188 enddo 189 190 parcours => Agrif_Gr%variables 191 192 do i=1,Agrif_Gr%NbVariables 193 if (.NOT. parcours%pvar%var%root_var%restaure) then 194 call Agrif_Deallocate_Arrays(parcours%pvar%var) 195 endif 196 if (associated(parcours%pvar%var%list_interp)) then 197 Call Agrif_Free_list_interp 198 & (parcours%pvar%var%list_interp) 199 endif 200 C 201 if ( .NOT. parcours%pvar%var%root_var % restaure) then 202 Deallocate(parcours%pvar%var) 203 C 204 endif 205 parcours => parcours%nextvariable 179 206 enddo 180 207 C … … 231 258 TYPE(Agrif_Grid),pointer :: Agrif_Gr ! Pointer on the current grid 232 259 INTEGER i 260 Type(Agrif_List_Variables), pointer :: parcours, rootparcours 233 261 C 234 262 C 235 263 do i = 1 , AGRIF_NbVariables 236 264 if ( Agrif_Mygrid % tabvars(i) % var % restaure) then 237 C238 if (associated(Agrif_Gr%tabvars(i)%var%array1)) then239 Deallocate(Agrif_Gr%tabvars(i)%var%array1)240 endif241 if (associated(Agrif_Gr%tabvars(i)%var%array2)) then242 Deallocate(Agrif_Gr%tabvars(i)%var%array2)243 endif244 if (associated(Agrif_Gr%tabvars(i)%var%array3)) then245 Deallocate(Agrif_Gr%tabvars(i)%var%array3)246 endif247 if (associated(Agrif_Gr%tabvars(i)%var%array4)) then248 Deallocate(Agrif_Gr%tabvars(i)%var%array4)249 endif250 if (associated(Agrif_Gr%tabvars(i)%var%array5)) then251 Deallocate(Agrif_Gr%tabvars(i)%var%array5)252 endif253 if (associated(Agrif_Gr%tabvars(i)%var%array6)) then254 Deallocate(Agrif_Gr%tabvars(i)%var%array6)255 endif256 !257 if (associated(Agrif_Gr%tabvars(i)%var%darray1)) then258 Deallocate(Agrif_Gr%tabvars(i)%var%darray1)259 endif260 if (associated(Agrif_Gr%tabvars(i)%var%darray2)) then261 Deallocate(Agrif_Gr%tabvars(i)%var%darray2)262 endif263 if (associated(Agrif_Gr%tabvars(i)%var%darray3)) then264 Deallocate(Agrif_Gr%tabvars(i)%var%darray3)265 endif266 if (associated(Agrif_Gr%tabvars(i)%var%darray4)) then267 Deallocate(Agrif_Gr%tabvars(i)%var%darray4)268 endif269 if (associated(Agrif_Gr%tabvars(i)%var%darray5)) then270 Deallocate(Agrif_Gr%tabvars(i)%var%darray5)271 endif272 if (associated(Agrif_Gr%tabvars(i)%var%darray6)) then273 Deallocate(Agrif_Gr%tabvars(i)%var%darray6)274 endif275 !276 if (associated(Agrif_Gr%tabvars(i)%var%larray1)) then277 Deallocate(Agrif_Gr%tabvars(i)%var%larray1)278 endif279 if (associated(Agrif_Gr%tabvars(i)%var%larray2)) then280 Deallocate(Agrif_Gr%tabvars(i)%var%larray2)281 endif282 if (associated(Agrif_Gr%tabvars(i)%var%larray3)) then283 Deallocate(Agrif_Gr%tabvars(i)%var%larray3)284 endif285 if (associated(Agrif_Gr%tabvars(i)%var%larray4)) then286 Deallocate(Agrif_Gr%tabvars(i)%var%larray4)287 endif288 if (associated(Agrif_Gr%tabvars(i)%var%larray5)) then289 Deallocate(Agrif_Gr%tabvars(i)%var%larray5)290 endif291 if (associated(Agrif_Gr%tabvars(i)%var%larray6)) then292 Deallocate(Agrif_Gr%tabvars(i)%var%larray6)293 endif294 !295 if (associated(Agrif_Gr%tabvars(i)%var%iarray1)) then296 Deallocate(Agrif_Gr%tabvars(i)%var%iarray1)297 endif298 if (associated(Agrif_Gr%tabvars(i)%var%iarray2)) then299 Deallocate(Agrif_Gr%tabvars(i)%var%iarray2)300 endif301 if (associated(Agrif_Gr%tabvars(i)%var%iarray3)) then302 Deallocate(Agrif_Gr%tabvars(i)%var%iarray3)303 endif304 if (associated(Agrif_Gr%tabvars(i)%var%iarray4)) then305 Deallocate(Agrif_Gr%tabvars(i)%var%iarray4)306 endif307 if (associated(Agrif_Gr%tabvars(i)%var%iarray5)) then308 Deallocate(Agrif_Gr%tabvars(i)%var%iarray5)309 endif310 if (associated(Agrif_Gr%tabvars(i)%var%iarray6)) then311 Deallocate(Agrif_Gr%tabvars(i)%var%iarray6)312 endif313 !314 if (associated(Agrif_Gr%tabvars(i)%var%carray1)) then315 Deallocate(Agrif_Gr%tabvars(i)%var%carray1)316 endif317 if (associated(Agrif_Gr%tabvars(i)%var%carray2)) then318 Deallocate(Agrif_Gr%tabvars(i)%var%carray2)319 endif320 !321 if (associated(Agrif_Gr%tabvars(i)%var%oldvalues2D)) then322 Deallocate(Agrif_Gr%tabvars(i)%var%oldvalues2D)323 endif324 if (associated(Agrif_Gr%tabvars(i)%var%interpIndex)) then325 Deallocate(Agrif_Gr%tabvars(i)%var%interpIndex)326 endif327 265 328 if (associated(Agrif_Gr%tabvars(i)%var%posvar)) then 329 Deallocate(Agrif_Gr%tabvars(i)%var%posvar) 330 endif 331 332 if (associated(Agrif_Gr%tabvars(i)%var%interptab)) then 333 Deallocate(Agrif_Gr%tabvars(i)%var%interptab) 334 endif 335 ! 266 call Agrif_Deallocate_Arrays(Agrif_Gr%tabvars(i)%var) 267 ! 336 268 Deallocate(Agrif_Gr%tabvars(i)%var) 337 269 ! 338 270 endif 339 271 enddo 272 273 parcours => Agrif_Gr%variables 274 rootparcours=>Agrif_Mygrid%variables 275 276 do i=1,Agrif_Gr%NbVariables 277 if (rootparcours%pvar%var%restaure) then 278 call Agrif_Deallocate_Arrays(parcours%pvar%var) 279 280 Deallocate(parcours%pvar%var) 281 C 282 endif 283 parcours => parcours%nextvariable 284 rootparcours => rootparcours%nextvariable 285 enddo 286 340 287 C 341 288 C … … 464 411 C 465 412 End Subroutine Agrif_CopyFromold 413 414 CC ************************************************************************** 415 CCC Subroutine AGRIF_CopyFromold_AllOneVar 416 C ************************************************************************** 417 C 418 Recursive Subroutine AGRIF_CopyFromold_AllOneVar(g,oldchildgrids, 419 & indic) 420 C 421 CCC Description: 422 CCC Routine called in the Agrif_Init_Hierarchy procedure 423 C (Agrif_Clustering module). 424 C 425 CC Method: 426 C 427 C Declarations: 428 C 429 430 C 431 C Pointer argument 432 TYPE(AGRIF_grid),pointer :: g ! Pointer on the current grid 433 TYPE(AGRIF_pgrid),pointer :: oldchildgrids 434 integer :: indic 435 C 436 C Local pointer 437 TYPE(AGRIF_pgrid),pointer :: parcours ! Pointer for the recursive 438 ! procedure 439 REAL g_eps,eps,oldgrid_eps 440 INTEGER :: out 441 INTEGER :: iii 442 C 443 out = 0 444 C 445 parcours => oldchildgrids 446 C 447 do while (associated(parcours)) 448 C 449 if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then 450 C 451 g_eps = huge(1.) 452 oldgrid_eps = huge(1.) 453 do iii = 1 , Agrif_Probdim 454 g_eps = min(g_eps,g % Agrif_d(iii)) 455 oldgrid_eps = min(oldgrid_eps, 456 & parcours % gr % Agrif_d(iii)) 457 enddo 458 C 459 eps = min(g_eps,oldgrid_eps)/100. 460 C 461 do iii = 1 , Agrif_Probdim 462 463 if (g % Agrif_d(iii) .LT. 464 & (parcours % gr % Agrif_d(iii) - eps)) then 465 C 466 parcours => parcours % next 467 C 468 out = 1 469 C 470 Exit 471 C 472 endif 473 C 474 enddo 475 if ( out .EQ. 1 ) Cycle 476 C 477 Call AGRIF_CopyFromOldOneVar(g,parcours%gr,indic) 478 C 479 endif 480 C 481 Call Agrif_CopyFromold_AllOneVar 482 & (g, parcours % gr % child_grids,indic) 483 C 484 parcours => parcours % next 485 C 486 enddo 487 C 488 C 489 Return 490 C 491 C 492 End Subroutine AGRIF_CopyFromold_AllOneVar 493 C 494 C 495 C 496 C ************************************************************************** 497 CCC Subroutine Agrif_CopyFromoldOneVar 498 C ************************************************************************** 499 C 500 Subroutine Agrif_CopyFromoldOneVar(Agrif_New_Gr,Agrif_Old_Gr, 501 & indic) 502 C 503 CCC Description: 504 CCC Call to the Agrif_Copy procedure. 505 C 506 CC Method: 507 CC 508 C 509 C Declarations: 510 C 511 512 C 513 C Pointer argument 514 TYPE(Agrif_Grid),Pointer :: Agrif_New_Gr ! Pointer on the current grid 515 TYPE(Agrif_Grid),Pointer :: Agrif_Old_Gr ! Pointer on an old grid 516 INTEGER :: indic 517 INTEGER :: i 518 TYPE(Agrif_PVariable),Pointer ::tabvars,oldtabvars 519 C 520 C 521 tabvars => Agrif_Search_Variable(Agrif_New_Gr,-indic) 522 oldtabvars => Agrif_Search_Variable(Agrif_Old_Gr,-indic) 523 524 Call Agrif_Nbdim_Allocation(tabvars%var, 525 & tabvars%var%lb,tabvars%var%ub, 526 & tabvars%var%nbdim) 527 528 Call Agrif_Copy(Agrif_New_Gr,Agrif_Old_Gr, 529 & tabvars,oldtabvars) 530 531 532 C 533 C 534 Return 535 C 536 C 537 End Subroutine Agrif_CopyFromoldOneVar 538 466 539 C 467 540 C … … 753 826 enddo 754 827 CASE (2) 828 755 829 i0 = ind_gmin(1) 756 830 do i = ind_newmin(1),ind_newmax(1) -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modtypes.F
r2528 r2673 37 37 INTEGER, PARAMETER :: Agrif_NbMaxGrids = 10 38 38 39 C MPI Communicator40 INTEGER :: mpi_comm_agrif41 39 C 42 40 C ************************************************************************** … … 126 124 ! List of the grid variables 127 125 TYPE(Agrif_PVariable), DIMENSION(:) ,Pointer :: tabvars 126 ! pointer on the save grid 127 TYPE(Agrif_grid) ,Pointer :: save_grid 128 128 C 129 129 ! Global x,y and z position … … 169 169 INTEGER :: NbVariables = 0 170 170 Type(Agrif_Flux), Pointer :: fluxes => NULL() 171 INTEGER :: level 172 ! level of the grid in the hierarchy 171 173 End TYPE Agrif_grid 172 174 C … … 198 200 C Arrays containing the values of the grid variables (REAL) 199 201 REAL :: array0 200 REAL , DIMENSION(:) ,Pointer :: array1 => NULL() 201 REAL , DIMENSION(:,:) ,Pointer :: array2 => NULL() 202 REAL , DIMENSION(:,:,:) ,Pointer :: array3 => NULL() 203 REAL , DIMENSION(:,:,:,:) ,Pointer :: array4 => NULL() 204 REAL , DIMENSION(:,:,:,:,:) ,Pointer :: array5 => NULL() 205 REAL , DIMENSION(:,:,:,:,:,:),Pointer :: array6 => NULL() 202 REAL , DIMENSION(:) ,ALLOCATABLE :: array1 203 REAL , DIMENSION(:,:) ,ALLOCATABLE :: array2 204 REAL , DIMENSION(:,:,:) ,ALLOCATABLE :: array3 205 REAL , DIMENSION(:,:,:,:) ,ALLOCATABLE :: array4 206 REAL , DIMENSION(:,:,:,:,:) ,ALLOCATABLE :: array5 207 REAL , DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: array6 208 209 REAL , DIMENSION(:) ,POINTER :: parray1 210 REAL , DIMENSION(:,:) ,POINTER :: parray2 211 REAL , DIMENSION(:,:,:) ,POINTER :: parray3 212 REAL , DIMENSION(:,:,:,:) ,POINTER :: parray4 213 REAL , DIMENSION(:,:,:,:,:) ,POINTER :: parray5 214 REAL , DIMENSION(:,:,:,:,:,:),POINTER :: parray6 215 206 216 C Arrays containing the values of the grid variables (REAL*8) 207 217 REAL*8 :: darray0 208 REAL*8, DIMENSION(:) , Pointer :: darray1 => NULL()209 REAL*8, DIMENSION(:,:) , Pointer :: darray2 => NULL()210 REAL*8, DIMENSION(:,:,:) , Pointer :: darray3 => NULL()211 REAL*8, DIMENSION(:,:,:,:) , Pointer :: darray4 => NULL()212 REAL*8, DIMENSION(:,:,:,:,:) , Pointer :: darray5 => NULL()213 REAL*8, DIMENSION(:,:,:,:,:,:), Pointer :: darray6 => NULL()218 REAL*8, DIMENSION(:) ,ALLOCATABLE :: darray1 219 REAL*8, DIMENSION(:,:) ,ALLOCATABLE :: darray2 220 REAL*8, DIMENSION(:,:,:) ,ALLOCATABLE :: darray3 221 REAL*8, DIMENSION(:,:,:,:) ,ALLOCATABLE :: darray4 222 REAL*8, DIMENSION(:,:,:,:,:) ,ALLOCATABLE :: darray5 223 REAL*8, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: darray6 214 224 C Arrays containing the values of the grid variables (REAL*4) 215 225 REAL*4 :: sarray0 216 REAL*4, DIMENSION(:) , Pointer :: sarray1 => NULL()217 REAL*4, DIMENSION(:,:) , Pointer :: sarray2 => NULL()218 REAL*4, DIMENSION(:,:,:) , Pointer :: sarray3 => NULL()219 REAL*4, DIMENSION(:,:,:,:) , Pointer :: sarray4 => NULL()220 REAL*4, DIMENSION(:,:,:,:,:) , Pointer :: sarray5 => NULL()221 REAL*4, DIMENSION(:,:,:,:,:,:), Pointer :: sarray6 => NULL()226 REAL*4, DIMENSION(:) ,ALLOCATABLE :: sarray1 227 REAL*4, DIMENSION(:,:) ,ALLOCATABLE :: sarray2 228 REAL*4, DIMENSION(:,:,:) ,ALLOCATABLE :: sarray3 229 REAL*4, DIMENSION(:,:,:,:) ,ALLOCATABLE :: sarray4 230 REAL*4, DIMENSION(:,:,:,:,:) ,ALLOCATABLE :: sarray5 231 REAL*4, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: sarray6 222 232 C Arrays containing the values of the grid variables (LOGICAL) 223 233 LOGICAL :: larray0 224 LOGICAL, DIMENSION(:) , Pointer :: larray1 => NULL()225 LOGICAL, DIMENSION(:,:) , Pointer :: larray2 => NULL()226 LOGICAL, DIMENSION(:,:,:) , Pointer :: larray3 => NULL()227 LOGICAL, DIMENSION(:,:,:,:) , Pointer :: larray4 => NULL()228 LOGICAL, DIMENSION(:,:,:,:,:) , Pointer :: larray5 => NULL()229 LOGICAL, DIMENSION(:,:,:,:,:,:), Pointer :: larray6 => NULL()234 LOGICAL, DIMENSION(:) ,ALLOCATABLE :: larray1 235 LOGICAL, DIMENSION(:,:) ,ALLOCATABLE :: larray2 236 LOGICAL, DIMENSION(:,:,:) ,ALLOCATABLE :: larray3 237 LOGICAL, DIMENSION(:,:,:,:) ,ALLOCATABLE :: larray4 238 LOGICAL, DIMENSION(:,:,:,:,:) ,ALLOCATABLE :: larray5 239 LOGICAL, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: larray6 230 240 C Arrays containing the values of the grid variables (INTEGER) 231 241 INTEGER :: iarray0 232 INTEGER, DIMENSION(:) , Pointer :: iarray1 => NULL()233 INTEGER, DIMENSION(:,:) , Pointer :: iarray2 => NULL()234 INTEGER, DIMENSION(:,:,:) , Pointer :: iarray3 => NULL()235 INTEGER, DIMENSION(:,:,:,:) , Pointer :: iarray4 => NULL()236 INTEGER, DIMENSION(:,:,:,:,:) , Pointer :: iarray5 => NULL()237 INTEGER, DIMENSION(:,:,:,:,:,:), Pointer :: iarray6 => NULL()242 INTEGER, DIMENSION(:) ,ALLOCATABLE :: iarray1 243 INTEGER, DIMENSION(:,:) ,ALLOCATABLE :: iarray2 244 INTEGER, DIMENSION(:,:,:) ,ALLOCATABLE :: iarray3 245 INTEGER, DIMENSION(:,:,:,:) ,ALLOCATABLE :: iarray4 246 INTEGER, DIMENSION(:,:,:,:,:) ,ALLOCATABLE :: iarray5 247 INTEGER, DIMENSION(:,:,:,:,:,:),ALLOCATABLE :: iarray6 238 248 C 239 249 INTEGER, DIMENSION(:) ,Pointer :: restore1D => NULL() … … 245 255 C 246 256 CHARACTER(2050) :: carray0 247 CHARACTER(200), DIMENSION(:) , Pointer :: carray1 => NULL()248 CHARACTER(200), DIMENSION(:,:) , Pointer :: carray2 => NULL()257 CHARACTER(200), DIMENSION(:) ,ALLOCATABLE :: carray1 258 CHARACTER(200), DIMENSION(:,:) ,ALLOCATABLE :: carray2 249 259 C 250 260 ! Array used for the time interpolation … … 375 385 REAL :: Agrif_SpecialValueFineGrid 376 386 C clustering PARAMETERs 377 INTEGER :: Agrif_Regridding 387 INTEGER :: Agrif_Regridding = 10 378 388 INTEGER :: Agrif_Minwidth 379 389 REAL :: Agrif_Efficiency = 0.7 … … 406 416 ! Agrif_USE_FIXED_GRIDS = 1 if AMR mode + fixed grid 407 417 ! else only AMR mode 408 INTEGER :: Agrif_USE_FIXED_GRIDS 418 INTEGER :: Agrif_USE_FIXED_GRIDS 419 INTEGER :: Agrif_Maxlevelloc 409 420 C 410 421 #ifdef key_mpp_mpi 411 422 INTEGER :: Agrif_Nbprocs ! Number of processors 412 423 INTEGER :: Agrif_ProcRank ! Rank of the current processor 413 INTEGER :: Agrif_Group ! Group associated to MPI_COMM_ AGRIF424 INTEGER :: Agrif_Group ! Group associated to MPI_COMM_WORLD 414 425 INTEGER :: Agrif_MPIPREC 415 426 #endif -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdate.F
r2528 r2673 72 72 External :: procname 73 73 Optional :: procname 74 REAL, DIMENSION(lbound(child%var%array1,1): 75 & ubound(child%var%array1,1)), Target :: tab ! Results 74 REAL, DIMENSION( 75 & child%var%lb(1):child%var%ub(1) 76 & ), Target :: tab ! Result 76 77 C 77 78 C … … 86 87 C 87 88 C Values on the current grid used for the update 88 childtemp % var % array1 => tab89 C childtemp % var % array1 => tab 89 90 90 91 childtemp % var % lb = child % var % lb … … 139 140 140 141 REAL, DIMENSION( 141 & lbound(child%var%array2,1):ubound(child%var%array2,1),142 & lbound(child%var%array2,2):ubound(child%var%array2,2)),143 & Target :: tab ! Results142 & child%var%lb(1):child%var%ub(1), 143 & child%var%lb(2):child%var%ub(2) 144 & ), Target :: tab ! Result 144 145 C 145 146 C … … 154 155 C 155 156 C Values on the current grid used for the update 156 childtemp % var % array2 => tab157 C childtemp % var % array2 => tab 157 158 158 159 childtemp % var % lb = child % var % lb … … 203 204 204 205 REAL, DIMENSION( 205 & lbound(child%var%array3,1):ubound(child%var%array3,1),206 & lbound(child%var%array3,2):ubound(child%var%array3,2),207 & lbound(child%var%array3,3):ubound(child%var%array3,3)),208 & Target :: tab ! Results206 & child%var%lb(1):child%var%ub(1), 207 & child%var%lb(2):child%var%ub(2), 208 & child%var%lb(3):child%var%ub(3) 209 & ), Target :: tab ! Results 209 210 C 210 211 C … … 219 220 C 220 221 C Values on the current grid used for the update 221 childtemp % var % array3 => tab222 C childtemp % var % array3 => tab 222 223 223 224 childtemp % var % lb = child % var % lb … … 268 269 Optional :: procname 269 270 REAL, DIMENSION( 270 & lbound(child%var%array4,1):ubound(child%var%array4,1),271 & lbound(child%var%array4,2):ubound(child%var%array4,2),272 & lbound(child%var%array4,3):ubound(child%var%array4,3),273 & lbound(child%var%array4,4):ubound(child%var%array4,4)),274 & Target :: tab ! Results271 & child%var%lb(1):child%var%ub(1), 272 & child%var%lb(2):child%var%ub(2), 273 & child%var%lb(3):child%var%ub(3), 274 & child%var%lb(4):child%var%ub(4) 275 & ), Target :: tab ! Results 275 276 C 276 277 C … … 285 286 C 286 287 C Values on the current grid used for the update 287 childtemp % var % array4 => tab288 C childtemp % var % array4 => tab 288 289 289 290 childtemp % var % lb = child % var % lb … … 336 337 337 338 REAL, DIMENSION( 338 & lbound(child%var%array5,1):ubound(child%var%array5,1),339 & lbound(child%var%array5,2):ubound(child%var%array5,2),340 & lbound(child%var%array5,3):ubound(child%var%array5,3),341 & lbound(child%var%array5,4):ubound(child%var%array5,4),342 & lbound(child%var%array5,5):ubound(child%var%array5,5)),343 & Target :: tab ! Results339 & child%var%lb(1):child%var%ub(1), 340 & child%var%lb(2):child%var%ub(2), 341 & child%var%lb(3):child%var%ub(3), 342 & child%var%lb(4):child%var%ub(4), 343 & child%var%lb(5):child%var%ub(5) 344 & ), Target :: tab ! Results 344 345 C 345 346 C … … 354 355 C 355 356 C Values on the current grid used for the update 356 childtemp % var % array5 => tab357 C childtemp % var % array5 => tab 357 358 358 359 childtemp % var % lb = child % var % lb … … 401 402 ! are done on the fine grid 402 403 REAL, DIMENSION( 403 & lbound(child%var%array6,1):ubound(child%var%array6,1),404 & lbound(child%var%array6,2):ubound(child%var%array6,2),405 & lbound(child%var%array6,3):ubound(child%var%array6,3),406 & lbound(child%var%array6,4):ubound(child%var%array6,4),407 & lbound(child%var%array6,5):ubound(child%var%array6,5),408 & lbound(child%var%array6,6):ubound(child%var%array6,6)),409 & Target :: tab ! Results404 & child%var%lb(1):child%var%ub(1), 405 & child%var%lb(2):child%var%ub(2), 406 & child%var%lb(3):child%var%ub(3), 407 & child%var%lb(4):child%var%ub(4), 408 & child%var%lb(5):child%var%ub(5), 409 & child%var%lb(6):child%var%ub(6) 410 & ), Target :: tab ! Results 410 411 C 411 412 C … … 420 421 C 421 422 C Values on the current grid used for the update 422 childtemp % var % array6 => tab423 C childtemp % var % array6 => tab 423 424 424 425 childtemp % var % lb = child % var % lb … … 522 523 case('N') ! No space DIMENSION 523 524 C 524 select case (nbdim) 525 C 526 case(1) 527 nbtab_Child(n) = SIZE(child % var % array1,n) - 1 528 case(2) 529 nbtab_Child(n) = SIZE(child % var % array2,n) - 1 530 case(3) 531 nbtab_Child(n) = SIZE(child % var % array3,n) - 1 532 case(4) 533 nbtab_Child(n) = SIZE(child % var % array4,n) - 1 534 case(5) 535 nbtab_Child(n) = SIZE(child % var % array5,n) - 1 536 case(6) 537 nbtab_Child(n) = SIZE(child % var % array6,n) - 1 538 C 539 end select 525 526 nbtab_Child(n) = child % var % ub(n) - child % var % lb(n) 540 527 C 541 528 C No interpolation but only a copy of the values of the grid variable … … 560 547 endif 561 548 enddo 562 549 563 550 IF (present(procname)) THEN 564 551 … … 716 703 indtab(i,1,1) = indtab(i,1,1) - coeffraf 717 704 indtab(i,1,2) = indtab(i,1,2) - 1 718 IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) 719 & .AND.(mod(coeffraf,2) == 1)) THEN720 indtab(i,1,1) = indtab(i,1,1) - 1721 indtab(i,1,2) = indtab(i,1,2) + 1705 C at this point, indices are OK for an average 706 IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN 707 indtab(i,1,1) = indtab(i,1,1) - coeffraf/2 708 indtab(i,1,2) = indtab(i,1,2) + coeffraf/2 722 709 ENDIF 723 710 ENDIF … … 757 744 758 745 CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN, 759 & MPI_COMM_ AGRIF,code)746 & MPI_COMM_WORLD,code) 760 747 761 748 lubglob(1:nbdim,2) = - lubglob(1:nbdim,2) … … 763 750 #endif 764 751 C 765 766 752 indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), 767 753 & lubglob(1:nbdim,1)) … … 771 757 C 772 758 C 773 774 759 IF (present(procname)) THEN 775 760 Call Agrif_UpdatenD … … 790 775 & posvartab_child,loctab_Child, 791 776 & nbdim) 792 ENDIF 777 ENDIF 793 778 C 794 779 C … … 899 884 indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1 900 885 IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 901 indtab(i,1,1) = indtab(i,1,1) - 1902 indtab(i,1,2) = indtab(i,1,2) + 1903 indtab(i,2,1) = indtab(i,2,1) - 1904 indtab(i,2,2) = indtab(i,2,2) + 1886 indtab(i,1,1) = indtab(i,1,1) - coeffraf/2 887 indtab(i,1,2) = indtab(i,1,2) + coeffraf/2 888 indtab(i,2,1) = indtab(i,2,1) - coeffraf/2 889 indtab(i,2,2) = indtab(i,2,2) + coeffraf/2 905 890 ENDIF 906 891 ENDIF … … 925 910 926 911 CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN, 927 & MPI_COMM_ AGRIF,code)912 & MPI_COMM_WORLD,code) 928 913 929 914 lubglob(1:nbdim,2) = - lubglob(1:nbdim,2) … … 1209 1194 1210 1195 Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim) 1211 1212 1213 1196 1214 1197 IF (present(procname)) THEN … … 1287 1270 C 1288 1271 Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim, 1289 & MPI_INTEGER,MPI_COMM_ AGRIF,code)1272 & MPI_INTEGER,MPI_COMM_WORLD,code) 1290 1273 1291 1274 IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var) … … 1300 1283 memberin1(1) = memberin 1301 1284 CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall, 1302 & 1,MPI_LOGICAL,MPI_COMM_ AGRIF,code)1285 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 1303 1286 1304 1287 Call Get_External_Data_first(tab4t(:,:,1), … … 1419 1402 C 1420 1403 Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim, 1421 & MPI_INTEGER,MPI_COMM_ AGRIF,code)1404 & MPI_INTEGER,MPI_COMM_WORLD,code) 1422 1405 1423 1406 IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var) … … 1432 1415 memberin1(1) = member 1433 1416 CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2, 1434 & 1,MPI_LOGICAL,MPI_COMM_ AGRIF,code)1417 & 1,MPI_LOGICAL,MPI_COMM_WORLD,code) 1435 1418 1436 1419 Call Get_External_Data_first(tab5t(:,:,1), … … 1742 1725 REAL :: positionmin,positionmax 1743 1726 INTEGER :: imin,imax 1727 INTEGER :: coeffraf 1744 1728 #endif 1745 1729 C … … 1770 1754 ENDIF 1771 1755 ELSE 1756 IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN 1772 1757 positionmin = positionmin - ds_Parent(i)/2. 1773 IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 1774 positionmin = positionmin - ds_Child(i) 1758 ELSE 1759 coeffraf = nint(ds_Parent(i)/ds_Child(i)) 1760 if (mod(coeffraf,2) == 1) then 1761 positionmin = positionmin - (ds_Parent(i)-ds_Child(i)) 1762 else 1763 positionmin = positionmin - (ds_Parent(i)-ds_Child(i))-ds_Child(i)/2. 1764 endif 1775 1765 ENDIF 1776 1766 ENDIF … … 1794 1784 ENDIF 1795 1785 ELSE 1786 IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN 1796 1787 positionmax = positionmax + ds_Parent(i)/2. 1797 IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN 1798 positionmax = positionmax + ds_Child(i) 1788 ELSE 1789 coeffraf = nint(ds_Parent(i)/ds_Child(i)) 1790 if (mod(coeffraf,2) == 1) then 1791 positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) 1792 else 1793 positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) + ds_Child(i)/2. 1794 endif 1795 1799 1796 ENDIF 1800 1797 ENDIF -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modupdatebasic.F
r2528 r2673 571 571 INTEGER :: i1,i2 572 572 REAL :: invsumweight 573 REAL :: weights(-(coeffraf -1):coeffraf-1)573 REAL :: weights(-(coeffraf):coeffraf) 574 574 575 575 C … … 595 595 C 596 596 597 it1 = -(coeffraf-1) 598 i1 = -(coeffraf-1)+locind_child_left+diffmod 599 i2 = 2*coeffraf - 2 600 597 if (diffmod == 1) THEN 598 invsumweight=1./(2.*coeffraf**2) 599 do i=-coeffraf,-1 600 weights(i) = invsumweight*(2*(coeffraf+i)+1) 601 enddo 602 do i=0,coeffraf-1 603 weights(i)=weights(-(i+1)) 604 enddo 605 it1 = -coeffraf 606 i1 = -(coeffraf-1)+locind_child_left 607 i2 = 2*coeffraf - 1 608 else 601 609 invsumweight=1./coeffraf**2 602 610 do i=-(coeffraf-1),0 … … 606 614 weights(i) = invsumweight*(coeffraf - i) 607 615 enddo 616 it1 = -(coeffraf-1) 617 i1 = -(coeffraf-1)+locind_child_left 618 i2 = 2*coeffraf - 2 619 endif 608 620 609 621 sumweight = 0 … … 638 650 enddo 639 651 C 652 640 653 Return 641 654 C -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/AGRIF_FILES/modutil.F
r2528 r2673 63 63 C 64 64 #ifdef key_mpp_mpi 65 Logical :: mpi_was_called 66 Integer :: code, ierr 65 Integer :: code 67 66 INCLUDE 'mpif.h' 68 67 C 69 68 C 70 Call Agrif_comm_def(mpi_comm_agrif)71 72 CALL mpi_initialized ( mpi_was_called, code )73 IF( code /= MPI_SUCCESS ) THEN74 WRITE(*, *) ': Error in routine mpi_initialized'75 CALL mpi_abort( mpi_comm_world, code, ierr )76 ENDIF77 78 IF( .NOT. mpi_was_called ) THEN79 CALL mpi_comm_dup( mpi_comm_world, mpi_comm_agrif, code)80 IF( code /= MPI_SUCCESS ) THEN81 WRITE(*, *) ' Agrif_Step: Error in routine mpi_comm_dup'82 CALL mpi_abort( mpi_comm_world, code, ierr )83 ENDIF84 ENDIF85 86 69 If (Agrif_Mygrid % ngridstep == 0) Then 87 Call MPI_COMM_SIZE(MPI_COMM_ AGRIF,Agrif_Nbprocs,code)88 Call MPI_COMM_RANK(MPI_COMM_ AGRIF,Agrif_ProcRank,code)89 Call MPI_COMM_GROUP(MPI_COMM_ AGRIF,Agrif_Group,code)70 Call MPI_COMM_SIZE(MPI_COMM_WORLD,Agrif_Nbprocs,code) 71 Call MPI_COMM_RANK(MPI_COMM_WORLD,Agrif_ProcRank,code) 72 Call MPI_COMM_GROUP(MPI_COMM_WORLD,Agrif_Group,code) 90 73 endif 91 74 #endif … … 234 217 C 235 218 if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 0 ) then 219 C 220 Call Agrif_Save_All(Agrif_oldmygrid) 236 221 C 237 222 Call Agrif_Free_before_All(Agrif_oldmygrid) … … 322 307 C Detection (Agrif_detect is a user s routine) 323 308 C 309 324 310 do iii = 1 , Agrif_Probdim 325 311 size(iii) = g%nb(iii) + 1 … … 440 426 C 441 427 End Subroutine Agrif_Free_before_All 428 C ************************************************************************** 429 CCC Subroutine Agrif_Save_All 430 C ************************************************************************** 431 C 432 Recursive Subroutine Agrif_Save_All(g) 433 C 434 CCC Description: 435 C 436 CC Method: 437 C 438 C Declarations: 439 C 440 C Pointer argument 441 Type(Agrif_pgrid),pointer :: g ! Pointer on the current grid 442 C 443 C Local pointer 444 Type(Agrif_pgrid),pointer :: parcours ! Pointer for the recursive 445 ! procedure 446 C 447 C 448 parcours => g 449 C 450 Do while (associated(parcours)) 451 If (.not. parcours%gr%fixed) Then 452 Call Agrif_Instance(parcours%gr) 453 Call Agrif_Before_Regridding() 454 parcours % gr % oldgrid = .TRUE. 455 endif 456 C 457 Call Agrif_Save_All (parcours % gr % child_grids) 458 C 459 parcours => parcours % next 460 enddo 461 C 462 Return 463 C 464 C 465 End Subroutine Agrif_Save_All 442 466 C 443 467 C … … 710 734 C The root coarse grid is a fixed grid 711 735 Agrif_Mygrid % fixed = .TRUE. 736 C Level of the root grid 737 Agrif_Mygrid % level = 0 738 C Maximum level in the hierarchy 739 Agrif_MaxLevelLoc = 0 740 712 741 C 713 742 C Number of the grid pointed by Agrif_Mygrid (root coarse grid) … … 725 754 C 726 755 Call Agrif_Instance (Agrif_Mygrid) 756 C 757 Call Agrif_Set_numberofcells(Agrif_Mygrid) 727 758 C 728 759 C Allocation of the array containing the values of the grid variables 729 760 Call Agrif_Allocation (Agrif_Mygrid) 730 761 C 731 Call Agrif_initialisations(Agrif_Mygrid) 762 Call Agrif_initialisations(Agrif_Mygrid) 732 763 C 733 764 nullify(Agrif_Mygrid % child_grids) … … 759 790 C 760 791 do nb = 1, Agrif_NbVariables 761 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % array1) )792 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array1) ) 762 793 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % array1) 763 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % array2) )794 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array2) ) 764 795 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % array2) 765 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % array3) )796 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array3) ) 766 797 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % array3) 767 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % array4) )798 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array4) ) 768 799 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % array4) 769 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % array5) )800 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array5) ) 770 801 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % array5) 771 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % array6) )802 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % array6) ) 772 803 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % array6) 773 804 C 774 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % iarray1) )805 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray1) ) 775 806 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray1) 776 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % iarray2) )807 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray2) ) 777 808 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray2) 778 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % iarray3) )809 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray3) ) 779 810 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray3) 780 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % iarray4) )811 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray4) ) 781 812 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray4) 782 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % iarray5) )813 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray5) ) 783 814 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray5) 784 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % iarray6) )815 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % iarray6) ) 785 816 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % iarray6) 786 817 C 787 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % larray1) )818 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray1) ) 788 819 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray1) 789 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % larray2) )820 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray2) ) 790 821 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray2) 791 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % larray3) )822 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray3) ) 792 823 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray3) 793 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % larray4) )824 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray4) ) 794 825 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray4) 795 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % larray5) )826 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray5) ) 796 827 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray5) 797 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % larray6) )828 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % larray6) ) 798 829 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % larray6) 799 830 C 800 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % carray1) )831 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray1) ) 801 832 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray1) 802 if ( a ssociated(Agrif_Mygrid % tabvars(nb) % var % carray2) )833 if ( allocated(Agrif_Mygrid % tabvars(nb) % var % carray2) ) 803 834 & Deallocate(Agrif_Mygrid % tabvars(nb) % var % carray2) 804 835 enddo -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/DiversListe.c
r2528 r2673 348 348 /* */ 349 349 /******************************************************************************/ 350 void Add_NameOfCommon_1(char *nom )350 void Add_NameOfCommon_1(char *nom,char *cursubroutinename) 351 351 { 352 352 listnom *newnom; … … 362 362 newnom=(listnom *) malloc (sizeof (listnom)); 363 363 strcpy(newnom->o_nom,nom); 364 strcpy(newnom->o_subroutinename,cursubroutinename); 364 365 Save_Length(nom,23); 365 366 newnom->suiv = List_NameOfCommon; … … 524 525 /* Creation of the string for the dimension of this variable */ 525 526 dimsempty = 1; 527 526 528 if ( d ) 527 529 { … … 542 544 if ( dimsempty == 1 ) newvar->var->v_dimsempty=1; 543 545 } 544 strcpy(newvar->var->v_readedlistdimension,listdimension); 545 Save_Length(listdimension,15); 546 547 /* strcpy(newvar->var->v_readedlistdimension,listdimension); 548 Save_Length(listdimension,15);*/ 546 549 /* */ 547 550 newvar->suiv = NULL; -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/Makefile.lex
r2528 r2673 1 1 # Compilation: 2 CC = cc -O -g 2 CC = cc -O -g -Wall 3 3 LEX = flex 4 4 5 5 # option de flex et pas de lex 6 6 LEXFLAGS=-i 7 YACC = byacc -t -v 7 YACC = byacc -t -v -g 8 YACC = bison -t -v -g 8 9 9 10 … … 38 39 convert.tab.c : convert.y decl.h 39 40 $(YACC) convert.y 40 mv -f y.tab.c convert.tab.c41 # mv -f y.tab.c convert.tab.c 41 42 fortran.tab.c : fortran.y decl.h 42 43 $(YACC) -p fortran fortran.y 43 mv -f y.tab.c fortran.tab.c 44 # mv -f y.tab.c fortran.tab.c 45 # mv -f y.output fortran.output 46 # mv -f y.dot fortran.dot 44 47 convert.yy.c : convert.lex 45 48 $(LEX) $(LEXFLAGS) -oconvert.yy.c convert.lex -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/SubLoopCreation.c
r2528 r2673 61 61 /* we should add the use agrif_uti l if it is necessary */ 62 62 WriteHeadofSubroutineLoop(); 63 WriteUsemoduleDeclaration( );63 WriteUsemoduleDeclaration(subroutinename); 64 64 if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, 65 65 " IMPLICIT NONE\n"); … … 69 69 /* from pointer) in the new subroutine */ 70 70 if ( mark == 1 ) fprintf(fortranout,"!!! 000000000000000 \n"); 71 71 72 if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(); 72 73 if ( mark == 1 ) fprintf(fortranout,"!!! 111111111111111 \n"); … … 95 96 { 96 97 AddUseAgrifUtil_0(fortranout); 97 WriteUsemoduleDeclaration( );98 WriteUsemoduleDeclaration(subroutinename); 98 99 WriteIncludeDeclaration(); 99 100 if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortranout, … … 103 104 if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbbbbbbbbbb \n"); 104 105 if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(1); 106 if ( mark == 1 ) fprintf(fortranout,"!!! bbbbbbccccccccc \n"); 105 107 WriteArgumentDeclaration_beforecall(); 106 108 /* writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortranout); … … 127 129 /* */ 128 130 /******************************************************************************/ 129 void WriteVariablelist_subloop(FILE *outputfile )131 void WriteVariablelist_subloop(FILE *outputfile,char *ligne) 130 132 { 131 133 listvar *parcours; 132 char ligne[LONG_C];133 134 int compteur; 134 135 … … 146 147 if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 147 148 { 148 if ( didvariableadded == 0 ) 149 { 150 strcpy(ligne,""); 151 } 152 else 153 { 154 if ( compteur == 0 ) strcpy(ligne,""); 149 if ( didvariableadded == 1 ) 150 { 155 151 strcat(ligne,","); 156 152 } 157 153 strcat(ligne,parcours->var->v_nomvar); 158 154 didvariableadded = 1; 159 compteur = compteur + 1;160 if ( compteur == 3 )161 {162 if ( retour77 == 0 )163 {164 strcat(ligne," &");165 fprintf(outputfile,"\n %s",ligne);166 155 } 167 else fprintf(outputfile,"\n & %s",ligne);168 compteur = 0;169 }170 }171 156 parcours = parcours -> suiv; 172 157 } … … 176 161 if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) 177 162 { 178 if ( didvariableadded == 0 ) 179 { 180 strcpy(ligne,""); 181 } 182 else 183 { 184 if ( compteur == 0 ) strcpy(ligne,""); 163 if ( didvariableadded == 1 ) 164 { 185 165 strcat(ligne,","); 186 166 } 187 167 strcat(ligne,parcours->var->v_nomvar); 188 168 didvariableadded = 1; 189 compteur = compteur + 1;190 if ( compteur == 3 )191 {192 if ( retour77 == 0 )193 {194 strcat(ligne," &");195 fprintf(outputfile,"\n %s",ligne);196 169 } 197 else fprintf(outputfile,"\n & %s",ligne);198 compteur = 0;199 }200 }201 170 parcours = parcours -> suiv; 202 }203 if ( compteur != 3 && compteur != 0 )204 {205 if ( retour77 == 0 ) fprintf(outputfile,"\n %s &",ligne);206 else fprintf(outputfile,"\n & %s ",ligne);207 171 } 208 172 if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop\n"); … … 224 188 /* */ 225 189 /******************************************************************************/ 226 void WriteVariablelist_subloop_Call(FILE *outputfile )190 void WriteVariablelist_subloop_Call(FILE *outputfile,char *ligne) 227 191 { 228 192 listvar *parcours; 229 char ligne[LONG_40M];230 193 char ligne2[10]; 231 194 int i; 232 195 int compteur ; 233 196 234 strcpy(ligne,"");235 236 197 if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Call\n"); 237 198 parcours = List_UsedInSubroutine_Var; … … 243 204 /* in the output file */ 244 205 if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 245 (parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type")) && 246 parcours->var->v_pointerdeclare == 0 206 (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) 247 207 ) 248 208 { 249 if ( didvariableadded == 0 ) 250 { 251 if ( retour77 == 1 ) strcpy(ligne,"\n & "); 252 else strcpy(ligne,"\n "); 253 } 254 else 255 { 256 if ( compteur == 0 ) 257 { 258 if ( retour77 == 1 ) strcpy(ligne,"\n & "); 259 else strcpy(ligne,"\n "); 260 } 209 if ( didvariableadded == 1 ) 210 { 261 211 strcat(ligne," , "); 262 212 } … … 266 216 /* the name of the variable */ 267 217 if ( SubloopScalar != 0 && 268 ( IsVarAllocatable_0(parcours->var->v_nomvar) == 0 &&269 parcours->var->v_pointerdeclare == 0) &&218 ( 219 (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))) && 270 220 parcours->var->v_nbdim != 0 ) 271 221 { … … 306 256 } 307 257 308 Save_Length(ligne,41);309 tofich(outputfile,ligne,0);258 // Save_Length(ligne,41); 259 // tofich(outputfile,ligne,0); 310 260 /* Now we should replace the last ", &" by " &" */ 311 261 /* if ( didvariableadded != 0 && retour77 == 0 ) fseek(outputfile,-1,SEEK_CUR); … … 330 280 /* */ 331 281 /******************************************************************************/ 332 void WriteVariablelist_subloop_Def(FILE *outputfile )282 void WriteVariablelist_subloop_Def(FILE *outputfile, char *ligne) 333 283 { 334 284 listvar *parcours; 335 285 /* char ligne[LONG_40M];*/ 336 char *ligne;337 286 int compteur; 338 287 339 /* strcpy(ligne," ");*/340 341 ligne=(char *)malloc(LONG_40M*sizeof(char));342 343 288 if ( todebug == 1 ) printf("Enter in WriteVariablelist_subloop_Def\n"); 344 289 parcours = List_UsedInSubroutine_Var; … … 350 295 /* in the output file */ 351 296 if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && 352 (parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type")) && 353 parcours->var->v_pointerdeclare == 0 297 (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) 354 298 ) 355 299 { 356 if ( didvariableadded == 0 ) 357 { 358 if ( retour77 == 1 ) strcpy(ligne,"\n &"); 359 else strcpy(ligne,"\n "); 360 } 361 else 362 { 363 if ( compteur == 0 ) 364 { 365 if ( retour77 == 1 ) strcpy(ligne,"\n & "); 366 else strcpy(ligne,"\n "); 300 if ( didvariableadded == 1 ) 301 { 302 strcat(ligne,","); 303 } 304 strcat(ligne,parcours->var->v_nomvar); 305 didvariableadded = 1; 367 306 } 368 strcat(ligne,",");369 }370 strcat(ligne,parcours->var->v_nomvar);371 compteur = compteur + 1;372 didvariableadded = 1;373 /* if ( compteur == 3 )374 {375 if ( retour77 == 0 )376 {377 strcat(ligne," &");378 fprintf(outputfile,"\n %s",ligne);379 }380 else fprintf(outputfile,"\n & %s",ligne);381 compteur = 0;382 }*/383 }384 307 parcours = parcours -> suiv; 385 308 } … … 390 313 }*/ 391 314 Save_Length(ligne,41); 392 tofich(outputfile,ligne,0);315 // tofich(outputfile,ligne,0); 393 316 394 317 /* Now we should replace the last ", &" by " &" */ … … 396 319 if ( didvariableadded == 0 ) fseek(outputfile,-1,SEEK_CUR);*/ 397 320 if ( todebug == 1 ) printf("Out of WriteVariablelist_subloop_Def\n"); 398 strcpy(ligne,"");399 321 400 free(ligne);401 322 } 402 323 … … 419 340 void WriteHeadofSubroutineLoop() 420 341 { 421 char ligne[LONG_ C];342 char ligne[LONG_40M]; 422 343 FILE * subloop; 423 344 … … 428 349 subloop = associate(ligne); 429 350 /* */ 430 if ( retour77 == 0 ) sprintf(ligne," subroutine Sub_Loop_%s( &" 431 ,subroutinename); 432 else sprintf(ligne," subroutine Sub_Loop_%s( ",subroutinename); 433 fprintf(subloop,ligne); 351 if (isrecursive) 352 { 353 sprintf(ligne," recursive subroutine Sub_Loop_%s(",subroutinename); 354 } 355 else 356 { 357 sprintf(ligne," subroutine Sub_Loop_%s(",subroutinename); 358 } 434 359 /* */ 435 WriteVariablelist_subloop(subloop );436 WriteVariablelist_subloop_Def(subloop );360 WriteVariablelist_subloop(subloop,ligne); 361 WriteVariablelist_subloop_Def(subloop,ligne); 437 362 /* */ 438 sprintf(ligne,")");439 fprintf(subloop,ligne);363 strcat(ligne,")"); 364 tofich(subloop,ligne,1); 440 365 /* if USE agrif_Uti l should be add */ 441 366 AddUseAgrifUtil_0(subloop); … … 461 386 void closeandcallsubloopandincludeit_0(int suborfun) 462 387 { 463 char ligne[LONG_ C];388 char ligne[LONG_40M]; 464 389 465 390 if ( firstpass == 0 ) 466 391 { 392 467 393 if ( todebug == 1 ) printf("Enter in closeandcallsubloopandincludeit_0\n"); 468 394 if ( IsTabvarsUseInArgument_0() == 1 ) … … 484 410 fprintf(oldfortranout," Call Agrif_Init_Grids () \n"); 485 411 /* Now we add the call af the new subroutine */ 486 if ( retour77 == 0 ) sprintf(ligne,"\n Call Sub_Loop_%s( &" 487 ,subroutinename); 488 else sprintf(ligne,"\n Call Sub_Loop_%s( ",subroutinename); 489 fprintf(fortranout,ligne); 412 sprintf(ligne,"\n Call Sub_Loop_%s( ",subroutinename); 490 413 /* Write the list of the local variables used in this new subroutine */ 491 WriteVariablelist_subloop(fortranout );414 WriteVariablelist_subloop(fortranout,ligne); 492 415 /* Write the list of the global tables used in this new subroutine */ 493 416 /* in doloop */ 494 WriteVariablelist_subloop_Call(fortranout );417 WriteVariablelist_subloop_Call(fortranout,ligne); 495 418 /* Close the parenthesis of the new subroutine called */ 496 sprintf(ligne,")"); 497 fprintf(fortranout,ligne); 419 strcat(ligne,")"); 420 421 tofich(fortranout,ligne,1); 422 498 423 /* We should close the original subroutine */ 499 424 if ( suborfun == 3 ) sprintf(ligne,"\n end program %s" … … 520 445 void closeandcallsubloop_contains_0() 521 446 { 522 char ligne[LONG_ C];447 char ligne[LONG_40M]; 523 448 524 449 if ( firstpass == 0 ) … … 548 473 fprintf(fortranout,ligne); 549 474 /* Write the list of the local variables used in this new subroutine */ 550 WriteVariablelist_subloop(fortranout );475 WriteVariablelist_subloop(fortranout,ligne); 551 476 /* Write the list of the global tables used in this new subroutine */ 552 477 /* in doloop */ 553 WriteVariablelist_subloop_Call(fortranout );478 WriteVariablelist_subloop_Call(fortranout,ligne); 554 479 /* Close the parenthesis of the new subroutine called */ 555 480 sprintf(ligne,")"); -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilAgrif.c
r2528 r2673 67 67 else if ( !strcasecmp(tokname,"Agrif_Set_UpdateType") ) agrifintheword = 1; 68 68 else if ( !strcasecmp(tokname,"Agrif_Set_restore") ) agrifintheword = 1; 69 else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1; 69 70 else if ( !strcasecmp(tokname,"agrif_init_grids") ) agrifintheword = 1; 70 71 else if ( !strcasecmp(tokname,"agrif_step") ) agrifintheword = 1; … … 107 108 listvar *newvar; 108 109 int out; 110 111 printf("ICI ident = %s\n",ident); 109 112 110 113 if ( firstpass == 0 ) … … 117 120 else newvar=newvar->suiv; 118 121 } 119 122 printf("out1 = %d\n",out); 120 123 if ( out == 0 ) 121 124 { … … 127 130 } 128 131 } 132 if (out == 1 && !strcasecmp(newvar->var->v_typevar,"type")) return; 133 129 134 if ( out == 0 ) 130 135 { … … 147 152 } 148 153 149 if ( out == 1 ) 150 { 154 if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 155 { 156 printf("ICIC3\n"); 151 157 /* remove the variable */ 152 158 RemoveWordCUR_0(fortranout,(long)(-lengthname), … … 183 189 else newvar=newvar->suiv; 184 190 } 185 if ( out == 1 )191 if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) 186 192 { 193 printf("ICICIC4 %s\n",newvar->var->v_typevar); 187 194 /* remove the variable */ 188 195 RemoveWordCUR_0(fortranout,(long)(-lengthname), -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilCharacter.c
r2528 r2673 284 284 ) 285 285 { 286 printf("--- in UtilCharacter we do not found the \n");286 /* printf("--- in UtilCharacter we do not found the \n"); 287 287 printf("--- variable %s, the module where this \n",nom); 288 288 printf("--- variable has been defined has not been\n"); 289 printf("--- found.\n"); 289 printf("--- found.\n");*/ 290 290 } 291 291 } … … 320 320 ) 321 321 { 322 322 323 if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) 323 324 { … … 330 331 sprintf(chartmp,"%c",nom[i]); 331 332 strcat(toprinttmp,chartmp); 333 332 334 } 333 335 /* */ -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c
r2528 r2673 97 97 /* Now we should give the definition of the variable in the */ 98 98 /* table List_UsedInSubroutine_Var */ 99 printf("QDKFLSDFKSLDF\n"); 99 100 strcpy(curvar->var->v_typevar,newvar->var->v_typevar); 100 101 strcpy(curvar->var->v_dimchar,newvar->var->v_dimchar); … … 102 103 curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven; 103 104 curvar->var->v_allocatable = newvar->var->v_allocatable; 105 curvar->var->v_target = newvar->var->v_target; 104 106 curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare; 105 107 curvar->var->v_indicetabvars = newvar->var->v_indicetabvars; … … 133 135 ) 134 136 { 137 strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile); 135 138 CopyRecord(curvar->var,newvar->var); 136 139 present = 1; … … 535 538 sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename); 536 539 tofich(module_declar,ligne,1); 540 sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename); 541 tofich(module_declar,ligne,1); 542 sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename); 543 tofich(module_declar,ligne,1); 537 544 } 538 545 } -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c
r2528 r2673 72 72 var->v_optionaldeclare = 0 ; 73 73 var->v_allocatable = 0 ; 74 var->v_target = 0 ; 74 75 var->v_dimsempty = 0 ; 75 76 var->v_dimension = (listdim *)NULL; … … 152 153 } 153 154 /* Si cette variable est declaree en save */ 154 if (SaveDeclare == 1 ) curvar->v_save = 1; 155 if (SaveDeclare == 1 ) { 156 curvar->v_save = 1; 157 } 158 155 159 /* Si cette variable est v_allocatable */ 156 160 if (Allocatabledeclare == 1 ) curvar->v_allocatable=1; 161 162 /* Si cette variable est v_targer */ 163 if (Targetdeclare == 1 ) curvar->v_target=1; 157 164 /* if INTENT spec has been given */ 158 165 if ( strcasecmp(IntentSpec,"") ) … … 202 209 tmpvar->v_save=parcours->var->v_save; 203 210 tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter; 211 printf("QLKDF\n"); 204 212 tmpvar->v_indicetabvars=parcours->var->v_indicetabvars; 205 213 strcpy(tmpvar->v_modulename,parcours->var->v_modulename); … … 220 228 tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare; 221 229 tmpvar->v_allocatable=parcours->var->v_allocatable; 230 tmpvar->v_target=parcours->var->v_target; 222 231 strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec); 223 232 tmpvar->v_dimsempty=parcours->var->v_dimsempty; … … 511 520 } 512 521 513 listname *Insertname(listname *lin,char *nom )522 listname *Insertname(listname *lin,char *nom, int sens) 514 523 { 515 524 listname *newvar ; … … 526 535 else 527 536 { 537 if (sens == 0) 538 { 528 539 tmpvar = lin ; 529 540 while (tmpvar->suiv) … … 533 544 tmpvar -> suiv = newvar; 534 545 } 546 else 547 { 548 newvar->suiv = lin; 549 lin = newvar; 550 } 551 } 535 552 return lin; 553 } 554 555 listname *concat_listname(listname *l1, listname *l2) 556 { 557 listname *tmpvar; 558 559 tmpvar = l1; 560 while (tmpvar->suiv) 561 { 562 tmpvar = tmpvar->suiv; 563 } 564 565 tmpvar->suiv = l2; 566 567 return l1; 568 } 569 570 void *createstringfromlistname(char *ligne, listname *lin) 571 { 572 listname *tmpvar; 573 574 strcpy(ligne,""); 575 tmpvar = lin; 576 while(tmpvar) 577 { 578 strcat(ligne,tmpvar->n_name); 579 if (tmpvar->suiv) strcat(ligne,","); 580 tmpvar=tmpvar->suiv; 581 } 536 582 } 537 583 … … 618 664 619 665 } 666 667 void Init_List_Data_Var() 668 { 669 listvar *parcours; 670 671 parcours = List_Data_Var_Cur; 672 673 if (List_Data_Var_Cur) 674 { 675 while (parcours) 676 { 677 List_Data_Var_Cur = List_Data_Var_Cur->suiv; 678 free(parcours); 679 parcours = List_Data_Var_Cur; 680 } 681 } 682 683 List_Data_Var_Cur = NULL; 684 685 } -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithParameterlist.c
r2528 r2673 49 49 if ( firstpass == 1 ) 50 50 { 51 if ( VariableIsParameter == 1 ) List_GlobalParameter_Var = 52 AddListvarToListvar(listin,List_GlobalParameter_Var,1); 51 if ( VariableIsParameter == 1 ) { 52 List_GlobalParameter_Var = AddListvarToListvar(listin,List_GlobalParameter_Var,1); 53 } 53 54 } 54 55 } -
branches/dev_r2586_dynamic_mem/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistdatavariable.c
r2528 r2673 48 48 /* */ 49 49 /******************************************************************************/ 50 void Add_Data_Var_1 ( char *name,char *values)50 void Add_Data_Var_1 (listvar **curlist,char *name,char *values) 51 51 { 52 52 listvar *newvar; 53 char ligne[LONG_C]; 53 54 54 if ( firstpass == 1 )55 {55 // if ( firstpass == 1 ) 56 // { 56 57 newvar=(listvar *)malloc(sizeof(listvar)); 57 58 newvar->var=(variable *)malloc(sizeof(variable)); … … 68 69 strcpy(newvar->var->v_commoninfile,mainfile); 69 70 Save_Length(mainfile,10); 70 strcpy(newvar->var->v_initialvalue,values); 71 Save_Length(values,14); 71 if (strchr(values,',') && strncasecmp(values,"'",1)) 72 { 73 sprintf(ligne,"(/%s/)",values); 74 } 75 else 76 strcpy(ligne,values); 77 78 strcpy(newvar->var->v_initialvalue,ligne); 79 Save_Length(ligne,14); 72 80 newvar->suiv = NULL; 73 74 if ( !List_Data_Var ) 81 if ( ! (*curlist) ) 75 82 { 76 List_Data_Var= newvar ;83 *curlist = newvar ; 77 84 } 78 85 else 79 86 { 80 newvar->suiv = List_Data_Var;81 List_Data_Var= newvar;87 newvar->suiv = *curlist; 88 *curlist = newvar; 82 89 } 90 // } 91 } 92 93 void Add_Data_Var_Names_01 (listvar **curlist,listname *l1,listname *l2) 94 { 95 listvar *newvar; 96 listvar *tmpvar; 97 listname *tmpvar1; 98 listname *tmpvar2; 99 char ligne[LONG_C]; 100 101 tmpvar1 = l1; 102 tmpvar2 = l2; 103 104 while (tmpvar1) 105 { 106 newvar=(listvar *)malloc(sizeof(listvar)); 107 newvar->var=(variable *)malloc(sizeof(variable)); 108 /* */ 109 Init_Variable(newvar->var); 110 /* */ 111 if ( inmoduledeclare == 1 ) newvar->var->v_module=1; 112 strcpy(newvar->var->v_nomvar,tmpvar1->n_name); 113 Save_Length(tmpvar1->n_name,4); 114 strcpy(newvar->var->v_subroutinename,subroutinename); 115 Save_Length(subroutinename,11); 116 strcpy(newvar->var->v_modulename,curmodulename); 117 Save_Length(curmodulename,6); 118 strcpy(newvar->var->v_commoninfile,mainfile); 119 Save_Length(mainfile,10); 120 121 strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);