Changeset 7584 for branches/2016/dev_merge_2016
- Timestamp:
- 2017-01-20T15:42:50+01:00 (7 years ago)
- Location:
- branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7577 r7584 53 53 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 54 54 #endif 55 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 56 PUBLIC iom_getatt, iom_use, iom_context_finalize 55 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 56 PUBLIC iom_getatt, iom_putatt, iom_gettime, iom_rstput, iom_put 57 PUBLIC iom_use, iom_context_finalize 57 58 58 59 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 69 70 INTERFACE iom_getatt 70 71 MODULE PROCEDURE iom_g0d_iatt, iom_g0d_ratt, iom_g0d_catt 72 END INTERFACE 73 INTERFACE iom_putatt 74 MODULE PROCEDURE iom_p0d_iatt, iom_p0d_ratt, iom_p0d_catt 71 75 END INTERFACE 72 76 INTERFACE iom_rstput … … 1068 1072 ENDIF 1069 1073 END SUBROUTINE iom_g0d_catt 1074 1075 !!---------------------------------------------------------------------- 1076 !! INTERFACE iom_putatt 1077 !!---------------------------------------------------------------------- 1078 SUBROUTINE iom_p0d_iatt( kiomid, cdatt, pvar, cdvar ) 1079 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1080 CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute 1081 INTEGER , INTENT(in ) :: pvar ! write field 1082 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1083 ! 1084 IF( kiomid > 0 ) THEN 1085 IF( iom_file(kiomid)%nfid > 0 ) THEN 1086 SELECT CASE (iom_file(kiomid)%iolib) 1087 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1088 CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1089 ELSE 1090 CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 1091 ENDIF 1092 CASE DEFAULT 1093 CALL ctl_stop( 'iom_p0d_iatt: accepted IO library is only jpnf90' ) 1094 END SELECT 1095 ENDIF 1096 ENDIF 1097 END SUBROUTINE iom_p0d_iatt 1098 1099 SUBROUTINE iom_p0d_ratt( kiomid, cdatt, pvar, cdvar ) 1100 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1101 CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute 1102 REAL(wp) , INTENT(in ) :: pvar ! write field 1103 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1104 ! 1105 IF( kiomid > 0 ) THEN 1106 IF( iom_file(kiomid)%nfid > 0 ) THEN 1107 SELECT CASE (iom_file(kiomid)%iolib) 1108 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1109 CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1110 ELSE 1111 CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 1112 ENDIF 1113 CASE DEFAULT 1114 CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' ) 1115 END SELECT 1116 ENDIF 1117 ENDIF 1118 END SUBROUTINE iom_p0d_ratt 1119 1120 SUBROUTINE iom_p0d_catt( kiomid, cdatt, pvar, cdvar ) 1121 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 1122 CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute 1123 CHARACTER(len=*), INTENT(in ) :: pvar ! write field 1124 CHARACTER(len=*), INTENT(in ), OPTIONAL :: cdvar ! Name of the variable 1125 ! 1126 IF( kiomid > 0 ) THEN 1127 IF( iom_file(kiomid)%nfid > 0 ) THEN 1128 SELECT CASE (iom_file(kiomid)%iolib) 1129 CASE (jpnf90 ) ; IF( PRESENT(cdvar) ) THEN 1130 CALL iom_nf90_putatt( kiomid, cdatt, pvar, cdvar=cdvar ) 1131 ELSE 1132 CALL iom_nf90_putatt( kiomid, cdatt, pvar ) 1133 ENDIF 1134 CASE DEFAULT 1135 CALL ctl_stop( 'iom_p0d_ratt: accepted IO library is only jpnf90' ) 1136 END SELECT 1137 ENDIF 1138 ENDIF 1139 END SUBROUTINE iom_p0d_catt 1070 1140 1071 1141 !!---------------------------------------------------------------------- -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r7577 r7584 30 30 31 31 PUBLIC iom_nf90_open, iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput 32 PUBLIC iom_nf90_getatt 32 PUBLIC iom_nf90_getatt, iom_nf90_putatt 33 33 34 34 INTERFACE iom_nf90_get … … 36 36 END INTERFACE 37 37 INTERFACE iom_nf90_getatt 38 MODULE PROCEDURE iom_nf90_iatt, iom_nf90_ratt, iom_nf90_catt 38 MODULE PROCEDURE iom_nf90_giatt, iom_nf90_gratt, iom_nf90_gcatt 39 END INTERFACE 40 INTERFACE iom_nf90_putatt 41 MODULE PROCEDURE iom_nf90_piatt, iom_nf90_pratt, iom_nf90_pcatt 39 42 END INTERFACE 40 43 INTERFACE iom_nf90_rstput … … 253 256 END FUNCTION iom_nf90_varid 254 257 258 !!---------------------------------------------------------------------- 259 !! INTERFACE iom_nf90_get 260 !!---------------------------------------------------------------------- 255 261 256 262 SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart ) … … 313 319 END SUBROUTINE iom_nf90_g123d 314 320 315 SUBROUTINE iom_nf90_iatt( kiomid, cdatt, pv_i0d, cdvar) 316 !!----------------------------------------------------------------------- 317 !! *** ROUTINE iom_nf90_iatt *** 321 !!---------------------------------------------------------------------- 322 !! INTERFACE iom_nf90_getatt 323 !!---------------------------------------------------------------------- 324 325 SUBROUTINE iom_nf90_giatt( kiomid, cdatt, pv_i0d, cdvar) 326 !!----------------------------------------------------------------------- 327 !! *** ROUTINE iom_nf90_giatt *** 318 328 !! 319 329 !! ** Purpose : read an integer attribute with NF90 … … 349 359 ! 350 360 IF( llok) THEN 351 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', iatt: '//TRIM(cdatt)361 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', giatt: '//TRIM(cdatt) 352 362 CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo) 353 363 ELSE … … 356 366 ENDIF 357 367 ! 358 END SUBROUTINE iom_nf90_ iatt359 360 SUBROUTINE iom_nf90_ ratt( kiomid, cdatt, pv_r0d, cdvar)361 !!----------------------------------------------------------------------- 362 !! *** ROUTINE iom_nf90_ iatt ***368 END SUBROUTINE iom_nf90_giatt 369 370 SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar) 371 !!----------------------------------------------------------------------- 372 !! *** ROUTINE iom_nf90_gratt *** 363 373 !! 364 374 !! ** Purpose : read a real attribute with NF90 … … 394 404 ! 395 405 IF( llok) THEN 396 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', ratt: '//TRIM(cdatt)406 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gratt: '//TRIM(cdatt) 397 407 CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo) 398 408 ELSE … … 401 411 ENDIF 402 412 ! 403 END SUBROUTINE iom_nf90_ ratt404 405 SUBROUTINE iom_nf90_ catt( kiomid, cdatt, pv_c0d, cdvar)406 !!----------------------------------------------------------------------- 407 !! *** ROUTINE iom_nf90_ iatt ***408 !! 409 !! ** Purpose : read a n integer attribute with NF90413 END SUBROUTINE iom_nf90_gratt 414 415 SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar) 416 !!----------------------------------------------------------------------- 417 !! *** ROUTINE iom_nf90_gcatt *** 418 !! 419 !! ** Purpose : read a character attribute with NF90 410 420 !! (either a global attribute (default) or a variable 411 421 !! attribute if optional variable name is supplied (cdvar)) … … 439 449 ! 440 450 IF( llok) THEN 441 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', catt: '//TRIM(cdatt)451 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gcatt: '//TRIM(cdatt) 442 452 CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, cdatt, values=pv_c0d), clinfo) 443 453 ELSE … … 446 456 ENDIF 447 457 ! 448 END SUBROUTINE iom_nf90_catt 458 END SUBROUTINE iom_nf90_gcatt 459 460 !!---------------------------------------------------------------------- 461 !! INTERFACE iom_nf90_putatt 462 !!---------------------------------------------------------------------- 463 464 SUBROUTINE iom_nf90_piatt( kiomid, cdatt, pv_i0d, cdvar) 465 !!----------------------------------------------------------------------- 466 !! *** ROUTINE iom_nf90_piatt *** 467 !! 468 !! ** Purpose : write an integer attribute with NF90 469 !! (either a global attribute (default) or a variable 470 !! attribute if optional variable name is supplied (cdvar)) 471 !!----------------------------------------------------------------------- 472 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 473 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 474 INTEGER , INTENT(in ) :: pv_i0d ! write field 475 CHARACTER(len=*), INTENT(in ), OPTIONAL & 476 & :: cdvar ! name of the variable 477 ! 478 INTEGER :: if90id ! temporary integer 479 INTEGER :: ivarid ! NetCDF variable Id 480 LOGICAL :: llok ! temporary logical 481 LOGICAL :: lenddef ! temporary logical 482 CHARACTER(LEN=100) :: clinfo ! info character 483 !--------------------------------------------------------------------- 484 ! 485 if90id = iom_file(kiomid)%nfid 486 lenddef = .false. 487 IF( PRESENT(cdvar) ) THEN 488 ! check the variable exists in the file 489 llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 490 IF( .NOT. llok ) THEN 491 CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found') 492 ENDIF 493 ELSE 494 llok = .true. 495 ivarid = NF90_GLOBAL 496 ENDIF 497 ! 498 IF( llok) THEN 499 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', piatt: '//TRIM(cdatt) 500 IF( iom_file(kiomid)%irec /= -1 ) THEN 501 ! trick: irec used to know if the file is in define mode or not 502 ! if it is not then temporarily put it into define mode 503 CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) 504 lenddef = .true. 505 ENDIF 506 ! 507 CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_i0d), clinfo) 508 ! 509 IF( lenddef ) THEN 510 ! file was in data mode on entry; put it back in that mode 511 CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo) 512 ENDIF 513 ELSE 514 CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written') 515 ENDIF 516 ! 517 END SUBROUTINE iom_nf90_piatt 518 519 SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar) 520 !!----------------------------------------------------------------------- 521 !! *** ROUTINE iom_nf90_pratt *** 522 !! 523 !! ** Purpose : write a real attribute with NF90 524 !! (either a global attribute (default) or a variable 525 !! attribute if optional variable name is supplied (cdvar)) 526 !!----------------------------------------------------------------------- 527 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 528 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 529 REAL(wp) , INTENT(in ) :: pv_r0d ! write field 530 CHARACTER(len=*), INTENT(in ), OPTIONAL & 531 & :: cdvar ! name of the variable 532 ! 533 INTEGER :: if90id ! temporary integer 534 INTEGER :: ivarid ! NetCDF variable Id 535 LOGICAL :: llok ! temporary logical 536 LOGICAL :: lenddef ! temporary logical 537 CHARACTER(LEN=100) :: clinfo ! info character 538 !--------------------------------------------------------------------- 539 ! 540 if90id = iom_file(kiomid)%nfid 541 lenddef = .false. 542 IF( PRESENT(cdvar) ) THEN 543 ! check the variable exists in the file 544 llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 545 IF( .NOT. llok ) THEN 546 CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found') 547 ENDIF 548 ELSE 549 llok = .true. 550 ivarid = NF90_GLOBAL 551 ENDIF 552 ! 553 IF( llok) THEN 554 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pratt: '//TRIM(cdatt) 555 IF( iom_file(kiomid)%irec /= -1 ) THEN 556 ! trick: irec used to know if the file is in define mode or not 557 ! if it is not then temporarily put it into define mode 558 CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) 559 lenddef = .true. 560 ENDIF 561 ! 562 CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_r0d), clinfo) 563 ! 564 IF( lenddef ) THEN 565 ! file was in data mode on entry; put it back in that mode 566 CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo) 567 ENDIF 568 ELSE 569 CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written') 570 ENDIF 571 ! 572 END SUBROUTINE iom_nf90_pratt 573 574 SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar) 575 !!----------------------------------------------------------------------- 576 !! *** ROUTINE iom_nf90_pcatt *** 577 !! 578 !! ** Purpose : write a character attribute with NF90 579 !! (either a global attribute (default) or a variable 580 !! attribute if optional variable name is supplied (cdvar)) 581 !!----------------------------------------------------------------------- 582 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 583 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 584 CHARACTER(len=*), INTENT(in ) :: pv_c0d ! write field 585 CHARACTER(len=*), INTENT(in ), OPTIONAL & 586 & :: cdvar ! name of the variable 587 ! 588 INTEGER :: if90id ! temporary integer 589 INTEGER :: ivarid ! NetCDF variable Id 590 LOGICAL :: llok ! temporary logical 591 LOGICAL :: lenddef ! temporary logical 592 CHARACTER(LEN=100) :: clinfo ! info character 593 !--------------------------------------------------------------------- 594 ! 595 if90id = iom_file(kiomid)%nfid 596 lenddef = .false. 597 IF( PRESENT(cdvar) ) THEN 598 ! check the variable exists in the file 599 llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr 600 IF( .NOT. llok ) THEN 601 CALL ctl_warn('iom_nf90_putatt: no variable '//cdvar//' found') 602 ENDIF 603 ELSE 604 llok = .true. 605 ivarid = NF90_GLOBAL 606 ENDIF 607 ! 608 IF( llok) THEN 609 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pcatt: '//TRIM(cdatt) 610 IF( iom_file(kiomid)%irec /= -1 ) THEN 611 ! trick: irec used to know if the file is in define mode or not 612 ! if it is not then temporarily put it into define mode 613 CALL iom_nf90_check(NF90_REDEF( if90id ), clinfo) 614 lenddef = .true. 615 ENDIF 616 ! 617 CALL iom_nf90_check(NF90_PUT_ATT(if90id, ivarid, cdatt, values=pv_c0d), clinfo) 618 ! 619 IF( lenddef ) THEN 620 ! file was in data mode on entry; put it back in that mode 621 CALL iom_nf90_check(NF90_ENDDEF( if90id ), clinfo) 622 ENDIF 623 ELSE 624 CALL ctl_warn('iom_nf90_putatt: no attribute '//cdatt//' written') 625 ENDIF 626 ! 627 END SUBROUTINE iom_nf90_pcatt 628 449 629 450 630 SUBROUTINE iom_nf90_gettime( kiomid, kvid, ptime, cdunits, cdcalendar )
Note: See TracChangeset
for help on using the changeset viewer.