Changeset 8817
- Timestamp:
- 2017-11-27T12:03:07+01:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO
- Files:
-
- 5 edited
-
LIM_SRC_3/icedyn_adv_pra.F90 (modified) (8 diffs)
-
LIM_SRC_3/icerst.F90 (modified) (8 diffs)
-
OPA_SRC/IOM/iom.F90 (modified) (53 diffs)
-
OPA_SRC/IOM/iom_def.F90 (modified) (2 diffs)
-
OPA_SRC/IOM/iom_nf90.F90 (modified) (35 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icedyn_adv_pra.F90
r8637 r8817 12 12 !! 'key_lim3' ESIM sea-ice model 13 13 !!---------------------------------------------------------------------- 14 !! ice_dyn_adv_pra : advection of sea ice using Prather scheme 14 !! ice_dyn_adv_pra : advection of sea ice using Prather scheme 15 !! adv_x, adv_y : Prather scheme applied in i- and j-direction, resp. 16 !! adv_pra_init : initialisation of the Prather scheme 17 !! adv_pra_rst : read/write Prather field in ice restart file, or initialized to zero 15 18 !!---------------------------------------------------------------------- 16 19 USE dom_oce ! ocean domain … … 32 35 33 36 ! Moments for advection 34 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxopw, syopw, sxxopw, syyopw, sxyopw ! open water in sea ice35 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxice, syice, sxxice, syyice, sxyice ! ice thickness 36 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsn , sysn , sxxsn , syysn , sxysn ! snow thickness … … 39 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsal, sysal, sxxsal, syysal, sxysal ! ice salinity 40 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage ! ice age 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxopw, syopw, sxxopw, syyopw, sxyopw ! open water in sea ice 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye ! ice layers heat content 41 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxap , syap , sxxap , syyap , sxyap ! melt pond fraction 42 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxvp , syvp , sxxvp , syyvp , sxyvp ! melt pond volume 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye ! ice layers heat content 44 ! 47 45 48 !! * Substitutions 46 49 # include "vectopt_loop_substitute.h90" … … 262 265 END SUBROUTINE ice_dyn_adv_pra 263 266 267 264 268 SUBROUTINE adv_x( pdf, put , pcrh, psm , ps0 , & 265 269 & psx, psxx, psy , psyy, psxy ) … … 608 612 END SUBROUTINE adv_y 609 613 614 610 615 SUBROUTINE adv_pra_init 611 616 !!------------------------------------------------------------------- … … 616 621 INTEGER :: ierr 617 622 !!------------------------------------------------------------------- 623 ! 624 ! !* allocate prather fields 618 625 ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , & 619 626 & sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & … … 632 639 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'adv_pra_init : unable to allocate ice arrays for Prather advection scheme') 633 640 ! 634 CALL adv_pra_rst( 'READ' ) !* read or initialize all required files641 CALL adv_pra_rst( 'READ' ) !* read or initialize all required files 635 642 ! 636 643 END SUBROUTINE adv_pra_init 644 637 645 638 646 SUBROUTINE adv_pra_rst( cdrw, kt ) … … 652 660 CHARACTER(len=25) :: znam 653 661 CHARACTER(len=2) :: zchar, zchar1 654 REAL(wp), DIMENSION(jpi,jpj ) :: z2d662 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z3d ! 3D workspace 655 663 !!---------------------------------------------------------------------- 656 664 ! 657 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialize 658 ! ! --------------- 659 IF( ln_rstart ) THEN !* Read the restart file 660 ! 661 id1 = iom_varid( numrir, 'sxopw' , ldstop = .FALSE. ) 662 ! 663 IF( id1 > 0 ) THEN ! fields exist 664 DO jl = 1, jpl 665 WRITE(zchar,'(I2.2)') jl 666 znam = 'sxice'//'_htc'//zchar 667 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 668 sxice(:,:,jl) = z2d(:,:) 669 znam = 'syice'//'_htc'//zchar 670 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 671 syice(:,:,jl) = z2d(:,:) 672 znam = 'sxxice'//'_htc'//zchar 673 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 674 sxxice(:,:,jl) = z2d(:,:) 675 znam = 'syyice'//'_htc'//zchar 676 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 677 syyice(:,:,jl) = z2d(:,:) 678 znam = 'sxyice'//'_htc'//zchar 679 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 680 sxyice(:,:,jl) = z2d(:,:) 681 znam = 'sxsn'//'_htc'//zchar 682 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 683 sxsn(:,:,jl) = z2d(:,:) 684 znam = 'sysn'//'_htc'//zchar 685 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 686 sysn(:,:,jl) = z2d(:,:) 687 znam = 'sxxsn'//'_htc'//zchar 688 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 689 sxxsn(:,:,jl) = z2d(:,:) 690 znam = 'syysn'//'_htc'//zchar 691 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 692 syysn(:,:,jl) = z2d(:,:) 693 znam = 'sxysn'//'_htc'//zchar 694 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 695 sxysn(:,:,jl) = z2d(:,:) 696 znam = 'sxa'//'_htc'//zchar 697 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 698 sxa(:,:,jl) = z2d(:,:) 699 znam = 'sya'//'_htc'//zchar 700 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 701 sya(:,:,jl) = z2d(:,:) 702 znam = 'sxxa'//'_htc'//zchar 703 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 704 sxxa(:,:,jl) = z2d(:,:) 705 znam = 'syya'//'_htc'//zchar 706 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 707 syya(:,:,jl) = z2d(:,:) 708 znam = 'sxya'//'_htc'//zchar 709 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 710 sxya(:,:,jl) = z2d(:,:) 711 znam = 'sxc0'//'_htc'//zchar 712 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 713 sxc0(:,:,jl) = z2d(:,:) 714 znam = 'syc0'//'_htc'//zchar 715 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 716 syc0(:,:,jl) = z2d(:,:) 717 znam = 'sxxc0'//'_htc'//zchar 718 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 719 sxxc0(:,:,jl) = z2d(:,:) 720 znam = 'syyc0'//'_htc'//zchar 721 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 722 syyc0(:,:,jl) = z2d(:,:) 723 znam = 'sxyc0'//'_htc'//zchar 724 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 725 sxyc0(:,:,jl) = z2d(:,:) 726 znam = 'sxsal'//'_htc'//zchar 727 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 728 sxsal(:,:,jl) = z2d(:,:) 729 znam = 'sysal'//'_htc'//zchar 730 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 731 sysal(:,:,jl) = z2d(:,:) 732 znam = 'sxxsal'//'_htc'//zchar 733 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 734 sxxsal(:,:,jl) = z2d(:,:) 735 znam = 'syysal'//'_htc'//zchar 736 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 737 syysal(:,:,jl) = z2d(:,:) 738 znam = 'sxysal'//'_htc'//zchar 739 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 740 sxysal(:,:,jl) = z2d(:,:) 741 znam = 'sxage'//'_htc'//zchar 742 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 743 sxage(:,:,jl) = z2d(:,:) 744 znam = 'syage'//'_htc'//zchar 745 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 746 syage(:,:,jl) = z2d(:,:) 747 znam = 'sxxage'//'_htc'//zchar 748 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 749 sxxage(:,:,jl) = z2d(:,:) 750 znam = 'syyage'//'_htc'//zchar 751 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 752 syyage(:,:,jl) = z2d(:,:) 753 znam = 'sxyage'//'_htc'//zchar 754 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 755 sxyage(:,:,jl)= z2d(:,:) 756 END DO 757 IF ( ln_pnd_H12 ) THEN 758 DO jl = 1, jpl 759 WRITE(zchar,'(I2.2)') jl 760 znam = 'sxap'//'_htc'//zchar 761 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 762 sxap(:,:,jl) = z2d(:,:) 763 znam = 'syap'//'_htc'//zchar 764 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 765 syap(:,:,jl) = z2d(:,:) 766 znam = 'sxxap'//'_htc'//zchar 767 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 768 sxxap(:,:,jl) = z2d(:,:) 769 znam = 'syyap'//'_htc'//zchar 770 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 771 syyap(:,:,jl) = z2d(:,:) 772 znam = 'sxyap'//'_htc'//zchar 773 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 774 sxyap(:,:,jl) = z2d(:,:) 775 776 znam = 'sxvp'//'_htc'//zchar 777 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 778 sxvp(:,:,jl) = z2d(:,:) 779 znam = 'syvp'//'_htc'//zchar 780 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 781 syvp(:,:,jl) = z2d(:,:) 782 znam = 'sxxvp'//'_htc'//zchar 783 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 784 sxxvp(:,:,jl) = z2d(:,:) 785 znam = 'syyvp'//'_htc'//zchar 786 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 787 syyvp(:,:,jl) = z2d(:,:) 788 znam = 'sxyvp'//'_htc'//zchar 789 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 790 sxyvp(:,:,jl) = z2d(:,:) 791 END DO 792 ENDIF 793 794 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ' , sxopw ) 795 CALL iom_get( numrir, jpdom_autoglo, 'syopw ' , syopw ) 796 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw' , sxxopw ) 797 CALL iom_get( numrir, jpdom_autoglo, 'syyopw' , syyopw ) 798 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw' , sxyopw ) 799 800 DO jl = 1, jpl 801 WRITE(zchar,'(I2.2)') jl 802 DO jk = 1, nlay_i 803 WRITE(zchar1,'(I2.2)') jk 804 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 805 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 806 sxe(:,:,jk,jl) = z2d(:,:) 807 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 808 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 809 sye(:,:,jk,jl) = z2d(:,:) 810 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 811 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 812 sxxe(:,:,jk,jl) = z2d(:,:) 813 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 814 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 815 syye(:,:,jk,jl) = z2d(:,:) 816 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 817 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 818 sxye(:,:,jk,jl) = z2d(:,:) 819 END DO 820 END DO 821 ! 822 ELSE ! start rheology from rest 823 IF(lwp) WRITE(numout,*) ' ==>> previous run without Prather, set moments to 0' 824 sxopw (:,:) = 0._wp ; sxice (:,:,:) = 0._wp ; sxsn (:,:,:) = 0._wp ; sxa (:,:,:) = 0._wp 825 syopw (:,:) = 0._wp ; syice (:,:,:) = 0._wp ; sysn (:,:,:) = 0._wp ; sya (:,:,:) = 0._wp 826 sxxopw(:,:) = 0._wp ; sxxice(:,:,:) = 0._wp ; sxxsn(:,:,:) = 0._wp ; sxxa (:,:,:) = 0._wp 827 syyopw(:,:) = 0._wp ; syyice(:,:,:) = 0._wp ; syysn(:,:,:) = 0._wp ; syya (:,:,:) = 0._wp 828 sxyopw(:,:) = 0._wp ; sxyice(:,:,:) = 0._wp ; sxysn(:,:,:) = 0._wp ; sxya (:,:,:) = 0._wp 829 ! 830 sxc0 (:,:,:) = 0._wp ; sxe (:,:,:,:) = 0._wp ; sxsal (:,:,:) = 0._wp ; sxage (:,:,:) = 0._wp 831 syc0 (:,:,:) = 0._wp ; sye (:,:,:,:) = 0._wp ; sysal (:,:,:) = 0._wp ; syage (:,:,:) = 0._wp 832 sxxc0 (:,:,:) = 0._wp ; sxxe (:,:,:,:) = 0._wp ; sxxsal (:,:,:) = 0._wp ; sxxage (:,:,:) = 0._wp 833 syyc0 (:,:,:) = 0._wp ; syye (:,:,:,:) = 0._wp ; syysal (:,:,:) = 0._wp ; syyage (:,:,:) = 0._wp 834 sxyc0 (:,:,:) = 0._wp ; sxye (:,:,:,:) = 0._wp ; sxysal (:,:,:) = 0._wp ; sxyage (:,:,:) = 0._wp 835 IF ( ln_pnd_H12 ) THEN 836 sxap (:,:,:) = 0._wp ; sxvp (:,:,:) = 0._wp 837 syap (:,:,:) = 0._wp ; syvp (:,:,:) = 0._wp 838 sxxap (:,:,:) = 0._wp ; sxxvp (:,:,:) = 0._wp 839 syyap (:,:,:) = 0._wp ; syyvp (:,:,:) = 0._wp 840 sxyap (:,:,:) = 0._wp ; sxyvp (:,:,:) = 0._wp 841 ENDIF 665 ! !==========================! 666 IF( TRIM(cdrw) == 'READ' ) THEN !== Read or initialize ==! 667 ! !==========================! 668 ! 669 IF( ln_rstart ) THEN ; id1 = iom_varid( numrir, 'sxopw' , ldstop = .FALSE. ) ! file exist: id1>0 670 ELSE ; id1 = 0 ! no restart: id1=0 671 ENDIF 672 ! 673 IF( id1 > 0 ) THEN !** Read the restart file **! 674 ! 675 ! ! ice thickness 676 CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice ) 677 CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice ) 678 CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice ) 679 CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice ) 680 CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice ) 681 ! ! snow thickness 682 CALL iom_get( numrir, jpdom_autoglo, 'sxsn' , sxsn ) 683 CALL iom_get( numrir, jpdom_autoglo, 'sysn' , sysn ) 684 CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn ) 685 CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn ) 686 CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn ) 687 ! ! lead fraction 688 CALL iom_get( numrir, jpdom_autoglo, 'sxa' , sxa ) 689 CALL iom_get( numrir, jpdom_autoglo, 'sya' , sya ) 690 CALL iom_get( numrir, jpdom_autoglo, 'sxxa' , sxxa ) 691 CALL iom_get( numrir, jpdom_autoglo, 'syya' , syya ) 692 CALL iom_get( numrir, jpdom_autoglo, 'sxya' , sxya ) 693 ! ! snow thermal content 694 CALL iom_get( numrir, jpdom_autoglo, 'sxc0' , sxc0 ) 695 CALL iom_get( numrir, jpdom_autoglo, 'syc0' , syc0 ) 696 CALL iom_get( numrir, jpdom_autoglo, 'sxxc0' , sxxc0 ) 697 CALL iom_get( numrir, jpdom_autoglo, 'syyc0' , syyc0 ) 698 CALL iom_get( numrir, jpdom_autoglo, 'sxyc0' , sxyc0 ) 699 ! ! ice salinity 700 CALL iom_get( numrir, jpdom_autoglo, 'sxsal' , sxsal ) 701 CALL iom_get( numrir, jpdom_autoglo, 'sysal' , sysal ) 702 CALL iom_get( numrir, jpdom_autoglo, 'sxxsal', sxxsal ) 703 CALL iom_get( numrir, jpdom_autoglo, 'syysal', syysal ) 704 CALL iom_get( numrir, jpdom_autoglo, 'sxysal', sxysal ) 705 ! ! ice age 706 CALL iom_get( numrir, jpdom_autoglo, 'sxage' , sxage ) 707 CALL iom_get( numrir, jpdom_autoglo, 'syage' , syage ) 708 CALL iom_get( numrir, jpdom_autoglo, 'sxxage', sxxage ) 709 CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage ) 710 CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage ) 711 ! ! open water in sea ice 712 CALL iom_get( numrir, jpdom_autoglo, 'sxopw ', sxopw ) 713 CALL iom_get( numrir, jpdom_autoglo, 'syopw ', syopw ) 714 CALL iom_get( numrir, jpdom_autoglo, 'sxxopw', sxxopw ) 715 CALL iom_get( numrir, jpdom_autoglo, 'syyopw', syyopw ) 716 CALL iom_get( numrir, jpdom_autoglo, 'sxyopw', sxyopw ) 717 ! ! ice layers heat content 718 DO jk = 1, nlay_i 719 WRITE(zchar1,'(I2.2)') jk 720 znam = 'sxe'//'_il'//zchar1 ; CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) ; sxe (:,:,jk,:) = z3d(:,:,:) 721 znam = 'sye'//'_il'//zchar1 ; CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) ; sye (:,:,jk,:) = z3d(:,:,:) 722 znam = 'sxxe'//'_il'//zchar1 ; CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) ; sxxe(:,:,jk,:) = z3d(:,:,:) 723 znam = 'syye'//'_il'//zchar1 ; CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) ; syye(:,:,jk,:) = z3d(:,:,:) 724 znam = 'sxye'//'_il'//zchar1 ; CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) ; sxye(:,:,jk,:) = z3d(:,:,:) 725 END DO 726 ! 727 IF( ln_pnd_H12 ) THEN ! melt pond fraction 728 CALL iom_get( numrir, jpdom_autoglo, 'sxap' , sxap ) 729 CALL iom_get( numrir, jpdom_autoglo, 'syap' , syap ) 730 CALL iom_get( numrir, jpdom_autoglo, 'sxxap', sxxap ) 731 CALL iom_get( numrir, jpdom_autoglo, 'syyap', syyap ) 732 CALL iom_get( numrir, jpdom_autoglo, 'sxyap', sxyap ) 733 ! ! melt pond volume 734 CALL iom_get( numrir, jpdom_autoglo, 'sxvp' , sxvp ) 735 CALL iom_get( numrir, jpdom_autoglo, 'syvp' , syvp ) 736 CALL iom_get( numrir, jpdom_autoglo, 'sxxvp', sxxvp ) 737 CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp ) 738 CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp ) 842 739 ENDIF 843 ELSE !* Start from rest 844 IF(lwp) WRITE(numout,*) ' ==>> start from rest: set moments to 0' 845 sxopw (:,:) = 0._wp ; sxice (:,:,:) = 0._wp ; sxsn (:,:,:) = 0._wp ; sxa (:,:,:) = 0._wp 846 syopw (:,:) = 0._wp ; syice (:,:,:) = 0._wp ; sysn (:,:,:) = 0._wp ; sya (:,:,:) = 0._wp 847 sxxopw(:,:) = 0._wp ; sxxice(:,:,:) = 0._wp ; sxxsn(:,:,:) = 0._wp ; sxxa (:,:,:) = 0._wp 848 syyopw(:,:) = 0._wp ; syyice(:,:,:) = 0._wp ; syysn(:,:,:) = 0._wp ; syya (:,:,:) = 0._wp 849 sxyopw(:,:) = 0._wp ; sxyice(:,:,:) = 0._wp ; sxysn(:,:,:) = 0._wp ; sxya (:,:,:) = 0._wp 850 ! 851 sxc0 (:,:,:) = 0._wp ; sxe (:,:,:,:) = 0._wp ; sxsal (:,:,:) = 0._wp ; sxage (:,:,:) = 0._wp 852 syc0 (:,:,:) = 0._wp ; sye (:,:,:,:) = 0._wp ; sysal (:,:,:) = 0._wp ; syage (:,:,:) = 0._wp 853 sxxc0 (:,:,:) = 0._wp ; sxxe (:,:,:,:) = 0._wp ; sxxsal (:,:,:) = 0._wp ; sxxage (:,:,:) = 0._wp 854 syyc0 (:,:,:) = 0._wp ; syye (:,:,:,:) = 0._wp ; syysal (:,:,:) = 0._wp ; syyage (:,:,:) = 0._wp 855 sxyc0 (:,:,:) = 0._wp ; sxye (:,:,:,:) = 0._wp ; sxysal (:,:,:) = 0._wp ; sxyage (:,:,:) = 0._wp 856 IF ( ln_pnd_H12 ) THEN 857 sxap (:,:,:) = 0._wp ; sxvp (:,:,:) = 0._wp 858 syap (:,:,:) = 0._wp ; syvp (:,:,:) = 0._wp 859 sxxap (:,:,:) = 0._wp ; sxxvp (:,:,:) = 0._wp 860 syyap (:,:,:) = 0._wp ; syyvp (:,:,:) = 0._wp 861 sxyap (:,:,:) = 0._wp ; sxyvp (:,:,:) = 0._wp 740 ! 741 ELSE !** start rheology from rest **! 742 ! 743 IF(lwp) WRITE(numout,*) ' ==>> start from rest OR previous run without Prather, set moments to 0' 744 ! 745 sxice = 0._wp ; syice = 0._wp ; sxxice = 0._wp ; syyice = 0._wp ; sxyice = 0._wp ! ice thickness 746 sxsn = 0._wp ; sysn = 0._wp ; sxxsn = 0._wp ; syysn = 0._wp ; sxysn = 0._wp ! snow thickness 747 sxa = 0._wp ; sya = 0._wp ; sxxa = 0._wp ; syya = 0._wp ; sxya = 0._wp ! lead fraction 748 sxc0 = 0._wp ; syc0 = 0._wp ; sxxc0 = 0._wp ; syyc0 = 0._wp ; sxyc0 = 0._wp ! snow thermal content 749 sxsal = 0._wp ; sysal = 0._wp ; sxxsal = 0._wp ; syysal = 0._wp ; sxysal = 0._wp ! ice salinity 750 sxage = 0._wp ; syage = 0._wp ; sxxage = 0._wp ; syyage = 0._wp ; sxyage = 0._wp ! ice age 751 sxopw = 0._wp ; syopw = 0._wp ; sxxopw = 0._wp ; syyopw = 0._wp ; sxyopw = 0._wp ! open water in sea ice 752 sxe = 0._wp ; sye = 0._wp ; sxxe = 0._wp ; syye = 0._wp ; sxye = 0._wp ! ice layers heat content 753 IF( ln_pnd_H12 ) THEN 754 sxap = 0._wp ; syap = 0._wp ; sxxap = 0._wp ; syyap = 0._wp ; sxyap = 0._wp ! melt pond fraction 755 sxvp = 0._wp ; syvp = 0._wp ; sxxvp = 0._wp ; syyvp = 0._wp ; sxyvp = 0._wp ! melt pond volume 862 756 ENDIF 863 757 ENDIF 864 758 ! 865 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 866 ! ! ------------------- 867 IF(lwp) WRITE(numout,*) '---- adv-rst ----' 759 ! !=====================================! 760 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN !== write in the ice restart file ==! 761 ! !=====================================! 762 IF(lwp) WRITE(numout,*) '---- ice-adv-rst ----' 868 763 iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1 869 764 ! 870 DO jl = 1, jpl 871 WRITE(zchar,'(I2.2)') jl 872 znam = 'sxice'//'_htc'//zchar 873 z2d(:,:) = sxice(:,:,jl) 874 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 875 znam = 'syice'//'_htc'//zchar 876 z2d(:,:) = syice(:,:,jl) 877 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 878 znam = 'sxxice'//'_htc'//zchar 879 z2d(:,:) = sxxice(:,:,jl) 880 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 881 znam = 'syyice'//'_htc'//zchar 882 z2d(:,:) = syyice(:,:,jl) 883 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 884 znam = 'sxyice'//'_htc'//zchar 885 z2d(:,:) = sxyice(:,:,jl) 886 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 887 znam = 'sxsn'//'_htc'//zchar 888 z2d(:,:) = sxsn(:,:,jl) 889 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 890 znam = 'sysn'//'_htc'//zchar 891 z2d(:,:) = sysn(:,:,jl) 892 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 893 znam = 'sxxsn'//'_htc'//zchar 894 z2d(:,:) = sxxsn(:,:,jl) 895 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 896 znam = 'syysn'//'_htc'//zchar 897 z2d(:,:) = syysn(:,:,jl) 898 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 899 znam = 'sxysn'//'_htc'//zchar 900 z2d(:,:) = sxysn(:,:,jl) 901 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 902 znam = 'sxa'//'_htc'//zchar 903 z2d(:,:) = sxa(:,:,jl) 904 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 905 znam = 'sya'//'_htc'//zchar 906 z2d(:,:) = sya(:,:,jl) 907 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 908 znam = 'sxxa'//'_htc'//zchar 909 z2d(:,:) = sxxa(:,:,jl) 910 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 911 znam = 'syya'//'_htc'//zchar 912 z2d(:,:) = syya(:,:,jl) 913 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 914 znam = 'sxya'//'_htc'//zchar 915 z2d(:,:) = sxya(:,:,jl) 916 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 917 znam = 'sxc0'//'_htc'//zchar 918 z2d(:,:) = sxc0(:,:,jl) 919 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 920 znam = 'syc0'//'_htc'//zchar 921 z2d(:,:) = syc0(:,:,jl) 922 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 923 znam = 'sxxc0'//'_htc'//zchar 924 z2d(:,:) = sxxc0(:,:,jl) 925 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 926 znam = 'syyc0'//'_htc'//zchar 927 z2d(:,:) = syyc0(:,:,jl) 928 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 929 znam = 'sxyc0'//'_htc'//zchar 930 z2d(:,:) = sxyc0(:,:,jl) 931 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 932 znam = 'sxsal'//'_htc'//zchar 933 z2d(:,:) = sxsal(:,:,jl) 934 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 935 znam = 'sysal'//'_htc'//zchar 936 z2d(:,:) = sysal(:,:,jl) 937 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 938 znam = 'sxxsal'//'_htc'//zchar 939 z2d(:,:) = sxxsal(:,:,jl) 940 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 941 znam = 'syysal'//'_htc'//zchar 942 z2d(:,:) = syysal(:,:,jl) 943 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 944 znam = 'sxysal'//'_htc'//zchar 945 z2d(:,:) = sxysal(:,:,jl) 946 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 947 znam = 'sxage'//'_htc'//zchar 948 z2d(:,:) = sxage(:,:,jl) 949 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 950 znam = 'syage'//'_htc'//zchar 951 z2d(:,:) = syage(:,:,jl) 952 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 953 znam = 'sxxage'//'_htc'//zchar 954 z2d(:,:) = sxxage(:,:,jl) 955 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 956 znam = 'syyage'//'_htc'//zchar 957 z2d(:,:) = syyage(:,:,jl) 958 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 959 znam = 'sxyage'//'_htc'//zchar 960 z2d(:,:) = sxyage(:,:,jl) 961 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 962 END DO 963 964 CALL iom_rstput( iter, nitrst, numriw, 'sxopw ' , sxopw ) 965 CALL iom_rstput( iter, nitrst, numriw, 'syopw ' , syopw ) 966 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw' , sxxopw ) 967 CALL iom_rstput( iter, nitrst, numriw, 'syyopw' , syyopw ) 968 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw' , sxyopw ) 969 970 DO jl = 1, jpl 971 WRITE(zchar,'(I2.2)') jl 972 DO jk = 1, nlay_i 973 WRITE(zchar1,'(I2.2)') jk 974 znam = 'sxe'//'_il'//zchar1//'_htc'//zchar 975 z2d(:,:) = sxe(:,:,jk,jl) 976 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 977 znam = 'sye'//'_il'//zchar1//'_htc'//zchar 978 z2d(:,:) = sye(:,:,jk,jl) 979 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 980 znam = 'sxxe'//'_il'//zchar1//'_htc'//zchar 981 z2d(:,:) = sxxe(:,:,jk,jl) 982 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 983 znam = 'syye'//'_il'//zchar1//'_htc'//zchar 984 z2d(:,:) = syye(:,:,jk,jl) 985 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 986 znam = 'sxye'//'_il'//zchar1//'_htc'//zchar 987 z2d(:,:) = sxye(:,:,jk,jl) 988 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 989 END DO 990 END DO 991 IF ( ln_pnd_H12 ) THEN 992 DO jl = 1, jpl 993 WRITE(zchar,'(I2.2)') jl 994 znam = 'sxap'//'_htc'//zchar 995 z2d(:,:) = sxap(:,:,jl) 996 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 997 znam = 'syap'//'_htc'//zchar 998 z2d(:,:) = syap(:,:,jl) 999 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1000 znam = 'sxxap'//'_htc'//zchar 1001 z2d(:,:) = sxxap(:,:,jl) 1002 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1003 znam = 'syyap'//'_htc'//zchar 1004 z2d(:,:) = syyap(:,:,jl) 1005 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1006 znam = 'sxyap'//'_htc'//zchar 1007 z2d(:,:) = sxyap(:,:,jl) 1008 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1009 1010 znam = 'sxvp'//'_htc'//zchar 1011 z2d(:,:) = sxvp(:,:,jl) 1012 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1013 znam = 'syvp'//'_htc'//zchar 1014 z2d(:,:) = syvp(:,:,jl) 1015 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1016 znam = 'sxxvp'//'_htc'//zchar 1017 z2d(:,:) = sxxvp(:,:,jl) 1018 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1019 znam = 'syyvp'//'_htc'//zchar 1020 z2d(:,:) = syyvp(:,:,jl) 1021 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1022 znam = 'sxyvp'//'_htc'//zchar 1023 z2d(:,:) = sxyvp(:,:,jl) 1024 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 1025 END DO 765 ! 766 ! In case Prather scheme is used for advection, write second order moments 767 ! ------------------------------------------------------------------------ 768 ! 769 ! ! ice thickness 770 CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice ) 771 CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice ) 772 CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice ) 773 CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice ) 774 CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice ) 775 ! ! snow thickness 776 CALL iom_rstput( iter, nitrst, numriw, 'sxsn' , sxsn ) 777 CALL iom_rstput( iter, nitrst, numriw, 'sysn' , sysn ) 778 CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn ) 779 CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn ) 780 CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn ) 781 ! ! lead fraction 782 CALL iom_rstput( iter, nitrst, numriw, 'sxa' , sxa ) 783 CALL iom_rstput( iter, nitrst, numriw, 'sya' , sya ) 784 CALL iom_rstput( iter, nitrst, numriw, 'sxxa' , sxxa ) 785 CALL iom_rstput( iter, nitrst, numriw, 'syya' , syya ) 786 CALL iom_rstput( iter, nitrst, numriw, 'sxya' , sxya ) 787 ! ! snow thermal content 788 CALL iom_rstput( iter, nitrst, numriw, 'sxc0' , sxc0 ) 789 CALL iom_rstput( iter, nitrst, numriw, 'syc0' , syc0 ) 790 CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0 ) 791 CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0 ) 792 CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0 ) 793 ! ! ice salinity 794 CALL iom_rstput( iter, nitrst, numriw, 'sxsal' , sxsal ) 795 CALL iom_rstput( iter, nitrst, numriw, 'sysal' , sysal ) 796 CALL iom_rstput( iter, nitrst, numriw, 'sxxsal', sxxsal ) 797 CALL iom_rstput( iter, nitrst, numriw, 'syysal', syysal ) 798 CALL iom_rstput( iter, nitrst, numriw, 'sxysal', sxysal ) 799 ! ! ice age 800 CALL iom_rstput( iter, nitrst, numriw, 'sxage' , sxage ) 801 CALL iom_rstput( iter, nitrst, numriw, 'syage' , syage ) 802 CALL iom_rstput( iter, nitrst, numriw, 'sxxage', sxxage ) 803 CALL iom_rstput( iter, nitrst, numriw, 'syyage', syyage ) 804 CALL iom_rstput( iter, nitrst, numriw, 'sxyage', sxyage ) 805 ! ! open water in sea ice 806 CALL iom_rstput( iter, nitrst, numriw, 'sxopw ', sxopw ) 807 CALL iom_rstput( iter, nitrst, numriw, 'syopw ', syopw ) 808 CALL iom_rstput( iter, nitrst, numriw, 'sxxopw', sxxopw ) 809 CALL iom_rstput( iter, nitrst, numriw, 'syyopw', syyopw ) 810 CALL iom_rstput( iter, nitrst, numriw, 'sxyopw', sxyopw ) 811 ! ! ice layers heat content 812 DO jk = 1, nlay_i 813 WRITE(zchar1,'(I2.2)') jk 814 znam = 'sxe'//'_il'//zchar1 ; z3d(:,:,:) = sxe (:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 815 znam = 'sye'//'_il'//zchar1 ; z3d(:,:,:) = sye (:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 816 znam = 'sxxe'//'_il'//zchar1 ; z3d(:,:,:) = sxxe(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 817 znam = 'syye'//'_il'//zchar1 ; z3d(:,:,:) = syye(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 818 znam = 'sxye'//'_il'//zchar1 ; z3d(:,:,:) = sxye(:,:,jk,:) ; CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 819 END DO 820 ! 821 IF( ln_pnd_H12 ) THEN ! melt pond fraction 822 CALL iom_rstput( iter, nitrst, numriw, 'sxap' , sxap ) 823 CALL iom_rstput( iter, nitrst, numriw, 'syap' , syap ) 824 CALL iom_rstput( iter, nitrst, numriw, 'sxxap', sxxap ) 825 CALL iom_rstput( iter, nitrst, numriw, 'syyap', syyap ) 826 CALL iom_rstput( iter, nitrst, numriw, 'sxyap', sxyap ) 827 ! ! melt pond volume 828 CALL iom_rstput( iter, nitrst, numriw, 'sxvp' , sxvp ) 829 CALL iom_rstput( iter, nitrst, numriw, 'syvp' , syvp ) 830 CALL iom_rstput( iter, nitrst, numriw, 'sxxvp', sxxvp ) 831 CALL iom_rstput( iter, nitrst, numriw, 'syyvp', syyvp ) 832 CALL iom_rstput( iter, nitrst, numriw, 'sxyvp', sxyvp ) 1026 833 ENDIF 1027 834 ! -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/LIM_SRC_3/icerst.F90
r8637 r8817 6 6 !! History: 3.0 ! 2005-04 (M. Vancoppenolle) Original code 7 7 !! - ! 2008-03 (C. Ethe) restart files in using IOM interface 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 !! 3.4 ! 2011-02 (G. Madec) dynamical allocation 9 !! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write 3D ice fields 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_lim3 … … 82 83 ENDIF 83 84 ! 84 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib )85 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib, kdlev = jpl ) 85 86 lrst_ice = .TRUE. 86 87 ENDIF … … 88 89 ! 89 90 IF( ln_icectl ) CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - Beginning the time step - ' ) ! control print 91 ! 90 92 END SUBROUTINE ice_rst_opn 91 93 … … 103 105 CHARACTER(len=25) :: znam 104 106 CHARACTER(len=2) :: zchar, zchar1 105 REAL(wp), DIMENSION(jpi,jpj ) :: z2d107 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z3d ! 3D workspace 106 108 !!---------------------------------------------------------------------- 107 109 … … 120 122 CALL iom_rstput( iter, nitrst, numriw, 'kt_ice' , REAL( iter , wp ) ) ! date 121 123 122 !!gm It is possible and easy to define a 3D domain size (jpi,jpj,jpl) or use a SIZE( tab, DIM=3) in iom_rtput ) 123 !!gm ===>>> just a simple iom_rstput( iter, nitrst, numriw, 'v_i', v_i ) etc... 124 !!gm "just" ask Sebatien 125 126 ! Prognostic variables 127 DO jl = 1, jpl 128 WRITE(zchar,'(I2.2)') jl 129 znam = 'v_i'//'_htc'//zchar 130 z2d(:,:) = v_i(:,:,jl) 131 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_i 132 znam = 'v_s'//'_htc'//zchar 133 z2d(:,:) = v_s(:,:,jl) 134 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_s 135 znam = 'sv_i'//'_htc'//zchar 136 z2d(:,:) = sv_i(:,:,jl) 137 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! sv_i 138 znam = 'oa_i'//'_htc'//zchar 139 z2d(:,:) = oa_i(:,:,jl) 140 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! oa_i 141 znam = 'a_i'//'_htc'//zchar 142 z2d(:,:) = a_i(:,:,jl) 143 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! a_i 144 znam = 't_su'//'_htc'//zchar 145 z2d(:,:) = t_su(:,:,jl) 146 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! t_su 124 ! Prognostic variables 125 CALL iom_rstput( iter, nitrst, numriw, 'v_i' , v_i ) 126 CALL iom_rstput( iter, nitrst, numriw, 'v_s' , v_s ) 127 CALL iom_rstput( iter, nitrst, numriw, 'sv_i', sv_i ) 128 CALL iom_rstput( iter, nitrst, numriw, 'oa_i', oa_i ) 129 CALL iom_rstput( iter, nitrst, numriw, 'a_i' , a_i ) 130 CALL iom_rstput( iter, nitrst, numriw, 't_su', t_su ) 131 ! 132 ! Melt ponds 133 CALL iom_rstput( iter, nitrst, numriw, 'a_ip', a_ip ) 134 CALL iom_rstput( iter, nitrst, numriw, 'v_ip', v_ip ) 135 ! 136 !!gm dangerous !!!!! ===>>>> better reading writing all snow layers ! 137 ! Snow enthalpy (1st snow layer only) 138 z3d = e_s(:,:,1,:) 139 CALL iom_rstput( iter, nitrst, numriw, 'tempt_sl1' , z3d ) 140 ! 141 ! Ice enthalpy (all ice layers) 142 DO jk = 1, nlay_i 143 WRITE(zchar1,'(I2.2)') jk 144 znam = 'tempt'//'_il'//zchar1 145 z3d(:,:,:) = e_i(:,:,jk,:) 146 CALL iom_rstput( iter, nitrst, numriw, znam , z3d ) 147 147 END DO 148 149 DO jl = 1, jpl 150 WRITE(zchar,'(I2.2)') jl 151 znam = 'a_ip'//'_htc'//zchar 152 z2d(:,:) = a_ip(:,:,jl) 153 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! a_ip 154 znam = 'v_ip'//'_htc'//zchar 155 z2d(:,:) = v_ip(:,:,jl) 156 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! v_ip 157 END DO 158 159 DO jl = 1, jpl 160 WRITE(zchar,'(I2.2)') jl 161 znam = 'tempt_sl1'//'_htc'//zchar 162 z2d(:,:) = e_s(:,:,1,jl) 163 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! e_s 164 DO jk = 1, nlay_i 165 WRITE(zchar1,'(I2.2)') jk 166 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar 167 z2d(:,:) = e_i(:,:,jk,jl) 168 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) ! e_i 169 END DO 170 END DO 171 148 ! 149 ! ice velocity 172 150 CALL iom_rstput( iter, nitrst, numriw, 'u_ice', u_ice ) ! u_ice 173 151 CALL iom_rstput( iter, nitrst, numriw, 'v_ice', v_ice ) ! v_ice … … 189 167 !! ** purpose : read restart file 190 168 !!---------------------------------------------------------------------- 191 INTEGER :: jk, jl192 INTEGER :: id1 ! local integer193 REAL(wp) :: zfice, ziter194 REAL(wp), DIMENSION(jpi,jpj) :: z2d169 INTEGER :: jk, jl 170 LOGICAL :: llok 171 INTEGER :: id1 ! local integer 172 INTEGER :: jlibalt = jprstlib 195 173 CHARACTER(len=25) :: znam 196 174 CHARACTER(len=2) :: zchar, zchar1 197 INTEGER :: jlibalt = jprstlib198 LOGICAL :: llok175 REAL(wp) :: zfice, ziter 176 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z3d ! 3D workspace 199 177 !!---------------------------------------------------------------------- 200 178 … … 205 183 ENDIF 206 184 207 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib )185 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib, kdlev = jpl ) 208 186 209 187 CALL iom_get( numrir, 'nn_fsbc', zfice ) … … 223 201 224 202 ! Prognostic variables 225 DO jl = 1, jpl 226 WRITE(zchar,'(I2.2)') jl 227 znam = 'v_i'//'_htc'//zchar 228 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 229 v_i(:,:,jl) = z2d(:,:) 230 znam = 'v_s'//'_htc'//zchar 231 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 232 v_s(:,:,jl) = z2d(:,:) 233 znam = 'sv_i'//'_htc'//zchar 234 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 235 sv_i(:,:,jl) = z2d(:,:) 236 znam = 'oa_i'//'_htc'//zchar 237 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 238 oa_i(:,:,jl) = z2d(:,:) 239 znam = 'a_i'//'_htc'//zchar 240 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 241 a_i(:,:,jl) = z2d(:,:) 242 znam = 't_su'//'_htc'//zchar 243 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 244 t_su(:,:,jl) = z2d(:,:) 245 END DO 246 203 CALL iom_get( numrir, jpdom_autoglo, 'v_i' , v_i ) 204 CALL iom_get( numrir, jpdom_autoglo, 'v_s' , v_s ) 205 CALL iom_get( numrir, jpdom_autoglo, 'sv_i', sv_i ) 206 CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 207 CALL iom_get( numrir, jpdom_autoglo, 'a_i' , a_i ) 208 CALL iom_get( numrir, jpdom_autoglo, 't_su', t_su ) 209 ! 210 ! Melt ponds 247 211 id1 = iom_varid( numrir, 'a_ip_htc01' , ldstop = .FALSE. ) 248 212 IF( id1 > 0 ) THEN ! fields exist (melt ponds) 249 DO jl = 1, jpl 250 WRITE(zchar,'(I2.2)') jl 251 znam = 'a_ip'//'_htc'//zchar 252 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 253 a_ip(:,:,jl) = z2d(:,:) 254 znam = 'v_ip'//'_htc'//zchar 255 CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 256 v_ip(:,:,jl) = z2d(:,:) 257 END DO 213 CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 214 CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 258 215 ELSE ! start from rest 259 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it '216 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it to zero' 260 217 a_ip(:,:,:) = 0._wp 261 218 v_ip(:,:,:) = 0._wp 262 219 ENDIF 263 264 DO jl = 1, jpl 265 WRITE(zchar,'(I2.2)') jl266 znam = 'tempt_sl1'//'_htc'//zchar267 CALL iom_get( numrir, jpdom_autoglo, znam , z2d )268 e_s(:,:,1,jl) = z2d(:,:)269 DO jk = 1, nlay_i270 WRITE(zchar1,'(I2.2)') jk271 znam = 'tempt'//'_il'//zchar1//'_htc'//zchar272 CALL iom_get( numrir, jpdom_autoglo, znam , z2d )273 e_i(:,:,jk,jl) = z2d(:,:)274 END DO220 ! 221 !!gm dangerous !!!!! ===>>>> better reading writing all snow layers ! 222 ! Snow enthalpy (1st snow layer only) 223 CALL iom_get( numrir, jpdom_autoglo, 'tempt_sl1' , z3d ) 224 e_s(:,:,1,:) = z3d 225 ! 226 ! Ice enthalpy (all ice layers) 227 DO jk = 1, nlay_i 228 WRITE(zchar1,'(I2.2)') jk 229 znam = 'tempt'//'_il'//zchar1 230 CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 231 e_i(:,:,jk,:) = z3d(:,:,:) 275 232 END DO 276 233 ! 234 ! ice velocity 277 235 CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 278 236 CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8586 r8817 1 1 MODULE iom 2 !!===================================================================== 2 !!====================================================================== 3 3 !! *** MODULE iom *** 4 4 !! Input/Output manager : Library to read input files 5 !!==================================================================== 5 !!====================================================================== 6 6 !! History : 2.0 ! 2005-12 (J. Belier) Original code 7 7 !! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO … … 10 10 !! 3.6 ! 2014-15 DIMG format removed 11 11 !! 3.6 ! 2015-15 (J. Harle) Added procedure to read REAL attributes 12 !!-------------------------------------------------------------------- 13 14 !!-------------------------------------------------------------------- 12 !! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 13 !!---------------------------------------------------------------------- 14 15 !!---------------------------------------------------------------------- 15 16 !! iom_open : open a file read only 16 17 !! iom_close : close a file or all files opened by iom … … 19 20 !! iom_varid : get the id of a variable in a file 20 21 !! iom_rstput : write a field in a restart file (interfaced to several routines) 21 !!-------------------------------------------------------------------- 22 !!---------------------------------------------------------------------- 22 23 USE dom_oce ! ocean space and time domain 23 24 USE c1d ! 1D vertical configuration … … 29 30 USE lib_mpp ! MPP library 30 31 #if defined key_iomput 31 USE sbc_oce , ONLY : nn_fsbc ! ocean space and time domain32 USE trc_oce , ONLY : nn_dttrc ! !: frequency of step on passive tracers33 USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes32 USE sbc_oce , ONLY : nn_fsbc ! ocean space and time domain 33 USE trc_oce , ONLY : nn_dttrc ! !: frequency of step on passive tracers 34 USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes 34 35 #if defined key_lim3 35 USE ice , ONLY : jpl36 USE ice , ONLY : jpl 36 37 #endif 37 38 USE domngb ! ocean space and time domain … … 80 81 81 82 !!---------------------------------------------------------------------- 82 !! NEMO/OPA 3.3 , NEMO Consortium (2010)83 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 83 84 !! $Id$ 84 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 85 86 !!---------------------------------------------------------------------- 86 87 87 CONTAINS 88 88 … … 95 95 !!---------------------------------------------------------------------- 96 96 CHARACTER(len=*), INTENT(in) :: cdname 97 ! 97 98 #if defined key_iomput 98 99 ! 99 100 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 100 101 TYPE(xios_date) :: start_date … … 104 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 105 106 !!---------------------------------------------------------------------- 106 107 ! 107 108 ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 108 109 ! 109 110 clname = cdname 110 111 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) … … 125 126 ! horizontal grid definition 126 127 CALL set_scalar 127 128 ! 128 129 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 129 130 CALL set_grid( "T", glamt, gphit ) … … 144 145 ENDIF 145 146 ENDIF 146 147 ! 147 148 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 148 149 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain … … 167 168 ENDIF 168 169 ENDIF 169 170 ! 170 171 ! vertical grid definition 171 172 CALL iom_set_axis_attr( "deptht", gdept_1d ) … … 173 174 CALL iom_set_axis_attr( "depthv", gdept_1d ) 174 175 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 175 176 ! 176 177 ! Add vertical grid bounds 177 178 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) … … 186 187 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 187 188 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 188 189 189 ! 190 190 # if defined key_floats 191 191 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 192 192 # endif 193 # if defined key_lim3193 # if defined key_lim3 194 194 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 195 195 ! SIMIP diagnostics (4 main arctic straits) 196 196 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 197 # endif197 # endif 198 198 CALL iom_set_axis_attr( "icbcla", class_num ) 199 199 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) … … 202 202 ! automatic definitions of some of the xml attributs 203 203 CALL set_xmlatt 204 204 ! 205 205 ! end file definition 206 206 dtime%second = rdt … … 209 209 210 210 CALL xios_update_calendar(0) 211 211 ! 212 212 DEALLOCATE( zt_bnds, zw_bnds ) 213 213 ! 214 214 #endif 215 215 ! 216 216 END SUBROUTINE iom_init 217 217 … … 239 239 240 240 241 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )241 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof, kdlev ) 242 242 !!--------------------------------------------------------------------- 243 243 !! *** SUBROUTINE iom_open *** … … 252 252 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 253 253 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 254 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels 254 255 255 256 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] … … 405 406 IF( istop == nstop ) THEN ! no error within this routine 406 407 SELECT CASE (iolib) 407 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar )408 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 408 409 CASE DEFAULT 409 410 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) … … 672 673 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 673 674 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 675 INTEGER :: inlev ! number of levels for 3D data 674 676 !--------------------------------------------------------------------- 675 677 ! 678 inlev = -1 679 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 676 680 clname = iom_file(kiomid)%name ! esier to read 677 681 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 774 778 istart(idmspc+1) = itime 775 779 776 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 780 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 781 istart(1:idmspc) = kstart(1:idmspc) 782 icnt(1:idmspc) = kcount(1:idmspc) 777 783 ELSE 778 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc) 784 IF(idom == jpdom_unknown ) THEN 785 icnt(1:idmspc) = idimsz(1:idmspc) 779 786 ELSE 780 787 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array … … 799 806 ENDIF 800 807 IF( PRESENT(pv_r3d) ) THEN 801 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkglo808 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 802 809 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3) 803 ELSE ; icnt(3) = jpk810 ELSE ; icnt(3) = inlev 804 811 ENDIF 805 812 ENDIF … … 884 891 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 885 892 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 886 IF( icnt(3) == jpk) THEN893 IF( icnt(3) == inlev ) THEN 887 894 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 888 895 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) … … 1133 1140 END SUBROUTINE iom_rp0d 1134 1141 1142 1135 1143 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1136 1144 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1153 1161 END SUBROUTINE iom_rp1d 1154 1162 1163 1155 1164 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1156 1165 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1173 1182 END SUBROUTINE iom_rp2d 1174 1183 1184 1175 1185 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1176 1186 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1234 1244 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1235 1245 #if defined key_iomput 1236 CALL xios_send_field( cdname, pfield3d)1246 CALL xios_send_field( cdname, pfield3d ) 1237 1247 #else 1238 1248 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 1239 1249 #endif 1240 1250 END SUBROUTINE iom_p3d 1251 1252 #if defined key_iomput 1253 1241 1254 !!---------------------------------------------------------------------- 1242 1243 #if defined key_iomput 1255 !! 'key_iomput' IOM interface 1256 !!---------------------------------------------------------------------- 1244 1257 1245 1258 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1246 1259 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1247 1260 & nvertex, bounds_lon, bounds_lat, area ) 1248 CHARACTER(LEN=*) , INTENT(in) :: cdid 1249 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1250 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1251 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1252 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1253 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1254 LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1255 1256 1257 IF ( xios_is_valid_domain (cdid) ) THEN 1261 !!---------------------------------------------------------------------- 1262 !!---------------------------------------------------------------------- 1263 CHARACTER(LEN=*) , INTENT(in) :: cdid 1264 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1265 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1266 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1267 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1268 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1269 LOGICAL , DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1270 !!---------------------------------------------------------------------- 1271 ! 1272 IF( xios_is_valid_domain (cdid) ) THEN 1258 1273 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1259 1274 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & … … 1261 1276 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1262 1277 ENDIF 1263 IF 1278 IF( xios_is_valid_domaingroup(cdid) ) THEN 1264 1279 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1265 1280 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & … … 1267 1282 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1268 1283 ENDIF 1269 1284 ! 1270 1285 CALL xios_solve_inheritance() 1271 1286 ! 1272 1287 END SUBROUTINE iom_set_domain_attr 1273 1288 1274 1289 1275 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1276 CHARACTER(LEN=*) , INTENT(in) :: cdid 1277 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1278 1279 IF ( xios_is_valid_zoom_domain (cdid) ) THEN 1280 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1281 & nj=nj) 1282 ENDIF 1290 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj ) 1291 !!---------------------------------------------------------------------- 1292 !!---------------------------------------------------------------------- 1293 CHARACTER(LEN=*) , INTENT(in) :: cdid 1294 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1295 !!---------------------------------------------------------------------- 1296 IF( xios_is_valid_zoom_domain(cdid) ) CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj ) 1283 1297 END SUBROUTINE iom_set_zoom_domain_attr 1284 1298 1285 1299 1286 1300 SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 1301 !!---------------------------------------------------------------------- 1302 !!---------------------------------------------------------------------- 1287 1303 CHARACTER(LEN=*) , INTENT(in) :: cdid 1288 1304 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 1289 1305 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1290 1291 IF 1292 IF 1293 IF 1294 ENDIF 1295 IF 1296 IF 1306 !!---------------------------------------------------------------------- 1307 IF( PRESENT(paxis) ) THEN 1308 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1309 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1310 ENDIF 1311 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1312 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 1297 1313 CALL xios_solve_inheritance() 1298 1314 END SUBROUTINE iom_set_axis_attr … … 1300 1316 1301 1317 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1302 CHARACTER(LEN=*) , INTENT(in) :: cdid 1303 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1304 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1305 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1306 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1307 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1308 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1318 !!---------------------------------------------------------------------- 1319 !!---------------------------------------------------------------------- 1320 CHARACTER(LEN=*) , INTENT(in) :: cdid 1321 TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_op 1322 TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_offset 1323 !!---------------------------------------------------------------------- 1324 IF( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1325 IF( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1309 1326 CALL xios_solve_inheritance() 1310 1327 END SUBROUTINE iom_set_field_attr … … 1312 1329 1313 1330 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 1331 !!---------------------------------------------------------------------- 1332 !!---------------------------------------------------------------------- 1314 1333 CHARACTER(LEN=*) , INTENT(in) :: cdid 1315 1334 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix 1316 IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1317 IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1335 !!---------------------------------------------------------------------- 1336 IF( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1337 IF( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1318 1338 CALL xios_solve_inheritance() 1319 1339 END SUBROUTINE iom_set_file_attr … … 1321 1341 1322 1342 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1343 !!---------------------------------------------------------------------- 1344 !!---------------------------------------------------------------------- 1323 1345 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1324 1346 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix … … 1329 1351 IF( PRESENT( name_suffix ) ) name_suffix = '' 1330 1352 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1331 IF 1353 IF( xios_is_valid_file (cdid) ) THEN 1332 1354 CALL xios_solve_inheritance() 1333 1355 CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) … … 1336 1358 IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq ) 1337 1359 ENDIF 1338 IF 1360 IF( xios_is_valid_filegroup(cdid) ) THEN 1339 1361 CALL xios_solve_inheritance() 1340 1362 CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) … … 1347 1369 1348 1370 SUBROUTINE iom_set_grid_attr( cdid, mask ) 1371 !!---------------------------------------------------------------------- 1372 !!---------------------------------------------------------------------- 1349 1373 CHARACTER(LEN=*) , INTENT(in) :: cdid 1350 1374 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1351 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1352 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1375 !!---------------------------------------------------------------------- 1376 IF( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1377 IF( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1353 1378 CALL xios_solve_inheritance() 1354 1379 END SUBROUTINE iom_set_grid_attr 1355 1380 1356 1381 SUBROUTINE iom_setkt( kt, cdname ) 1382 !!---------------------------------------------------------------------- 1383 !!---------------------------------------------------------------------- 1357 1384 INTEGER , INTENT(in) :: kt 1358 1385 CHARACTER(LEN=*), INTENT(in) :: cdname 1359 ! 1386 !!---------------------------------------------------------------------- 1360 1387 CALL iom_swap( cdname ) ! swap to cdname context 1361 1388 CALL xios_update_calendar(kt) 1362 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1363 ! 1389 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1364 1390 END SUBROUTINE iom_setkt 1365 1391 1366 1392 SUBROUTINE iom_context_finalize( cdname ) 1393 !!---------------------------------------------------------------------- 1394 !!---------------------------------------------------------------------- 1367 1395 CHARACTER(LEN=*), INTENT(in) :: cdname 1368 ! 1396 !!---------------------------------------------------------------------- 1369 1397 IF( xios_is_valid_context(cdname) ) THEN 1370 1398 CALL iom_swap( cdname ) ! swap to cdname context … … 1372 1400 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1373 1401 ENDIF 1374 !1375 1402 END SUBROUTINE iom_context_finalize 1376 1403 … … 1381 1408 !! 1382 1409 !! ** Purpose : define horizontal grids 1383 !!1384 1410 !!---------------------------------------------------------------------- 1385 1411 CHARACTER(LEN=1) , INTENT(in) :: cdgrd … … 1387 1413 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1388 1414 ! 1415 INTEGER :: ni,nj 1389 1416 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1390 INTEGER :: ni,nj1391 1417 !!---------------------------------------------------------------------- 1418 ! 1392 1419 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1393 1420 ! 1394 1421 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1395 1422 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1396 1423 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & 1397 1424 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1398 1425 ! 1399 1426 IF ( ln_mskland ) THEN 1400 1427 ! mask land points, keep values on coast line -> specific mask for U, V and W points … … 1409 1436 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 1410 1437 ENDIF 1411 1438 ! 1412 1439 END SUBROUTINE set_grid 1413 1440 … … 1420 1447 !! 1421 1448 !!---------------------------------------------------------------------- 1422 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1423 ! 1424 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1425 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j) 1426 ! 1427 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1428 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1429 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1430 ! 1431 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1432 ! ! represents the bottom-left corner of cell (i,j) 1449 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1450 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coord. of a contiguous vertex of cell (i,j) 1451 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 1452 ! 1433 1453 INTEGER :: ji, jj, jn, ni, nj 1434 1454 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1455 ! ! represents the bottom-left corner of cell (i,j) 1456 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1457 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1458 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1459 !!---------------------------------------------------------------------- 1460 ! 1435 1461 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1436 1462 ! 1437 1463 ! Offset of coordinate representing bottom-left corner 1438 1464 SELECT CASE ( TRIM(cdgrd) ) 1439 CASE ('T', 'W') 1440 icnr = -1 ; jcnr = -1 1441 CASE ('U') 1442 icnr = 0 ; jcnr = -1 1443 CASE ('V') 1444 icnr = -1 ; jcnr = 0 1465 CASE ('T', 'W') ; icnr = -1 ; jcnr = -1 1466 CASE ('U') ; icnr = 0 ; jcnr = -1 1467 CASE ('V') ; icnr = -1 ; jcnr = 0 1445 1468 END SELECT 1446 1469 ! 1447 1470 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1448 1471 ! 1449 1472 z_fld(:,:) = 1._wp 1450 1473 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1451 1474 ! 1452 1475 ! Cell vertices that can be defined 1453 1476 DO jj = 2, jpjm1 … … 1463 1486 END DO 1464 1487 END DO 1465 1488 ! 1466 1489 ! Cell vertices on boundries 1467 1490 DO jn = 1, 4 … … 1469 1492 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1470 1493 END DO 1471 1494 ! 1472 1495 ! Zero-size cells at closed boundaries if cell points provided, 1473 1496 ! otherwise they are closed cells with unrealistic bounds … … 1494 1517 ENDIF 1495 1518 ENDIF 1496 1497 ! Rotate cells at the north fold 1498 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 1519 ! 1520 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN ! Rotate cells at the north fold 1499 1521 DO jj = 1, jpj 1500 1522 DO ji = 1, jpi … … 1506 1528 END DO 1507 1529 END DO 1508 1509 ! Invert cells at the symmetric equator 1510 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1530 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN ! Invert cells at the symmetric equator 1511 1531 DO ji = 1, jpi 1512 1532 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) … … 1515 1535 END DO 1516 1536 ENDIF 1517 1537 ! 1518 1538 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1519 1520 1539 & bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1540 ! 1521 1541 DEALLOCATE( z_bnds, z_fld, z_rot ) 1522 1542 ! 1523 1543 END SUBROUTINE set_grid_bounds 1524 1544 … … 1535 1555 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1536 1556 INTEGER :: ni,nj, ix, iy 1537 1538 1557 !!---------------------------------------------------------------------- 1558 ! 1539 1559 ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk) 1540 1560 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1541 1542 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1561 ! 1562 CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 1563 ! CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1543 1564 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1544 1565 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1551 1572 END SUBROUTINE set_grid_znl 1552 1573 1574 1553 1575 SUBROUTINE set_scalar 1554 1576 !!---------------------------------------------------------------------- … … 1560 1582 REAL(wp), DIMENSION(1) :: zz = 1. 1561 1583 !!---------------------------------------------------------------------- 1562 1584 ! 1563 1585 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 1564 1586 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1565 1566 zz =REAL(narea,wp)1587 ! 1588 zz = REAL( narea, wp ) 1567 1589 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1568 1590 ! 1569 1591 END SUBROUTINE set_scalar 1570 1592 … … 1637 1659 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1638 1660 CALL set_mooring( zlonpira, zlatpira ) 1639 1640 1661 ! 1641 1662 END SUBROUTINE set_xmlatt 1642 1663 1643 1664 1644 SUBROUTINE set_mooring( plon, plat )1665 SUBROUTINE set_mooring( plon, plat ) 1645 1666 !!---------------------------------------------------------------------- 1646 1667 !! *** ROUTINE set_mooring *** … … 1649 1670 !! 1650 1671 !!---------------------------------------------------------------------- 1651 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat! longitudes/latitudes oft the mooring1672 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring 1652 1673 ! 1653 1674 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name … … 1798 1819 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1799 1820 END DO 1800 1821 ! 1801 1822 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1802 1823 DO WHILE ( idx /= 0 ) … … 1805 1826 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1806 1827 END DO 1807 1828 ! 1808 1829 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1809 1830 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1810 1831 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) 1811 1812 ENDIF 1813 1832 ! 1833 ENDIF 1834 ! 1814 1835 END DO 1815 1836 ! 1816 1837 END SUBROUTINE iom_update_file_name 1817 1838 … … 1822 1843 !! 1823 1844 !! ** Purpose : send back the date corresponding to the given julian day 1824 !!1825 1845 !!---------------------------------------------------------------------- 1826 1846 REAL(wp), INTENT(in ) :: pjday ! julian day … … 1833 1853 REAL(wp) :: zsec 1834 1854 LOGICAL :: ll24, llfull 1855 !!---------------------------------------------------------------------- 1835 1856 ! 1836 1857 IF( PRESENT(ld24) ) THEN ; ll24 = ld24 1837 1858 ELSE ; ll24 = .FALSE. 1838 1859 ENDIF 1839 1860 ! 1840 1861 IF( PRESENT(ldfull) ) THEN ; llfull = ldfull 1841 1862 ELSE ; llfull = .FALSE. 1842 1863 ENDIF 1843 1864 ! 1844 1865 CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 1845 1866 isec = NINT(zsec) 1846 1867 ! 1847 1868 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 1848 1869 CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 1849 1870 isec = 86400 1850 1871 ENDIF 1851 1872 ! 1852 1873 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 1853 1874 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 1854 1875 ENDIF 1855 1876 ! 1856 1877 !$AGRIF_DO_NOT_TREAT 1857 ! Should be fixed in the conv1878 ! needed in the conv 1858 1879 IF( llfull ) THEN 1859 1880 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1867 1888 ENDIF 1868 1889 !$AGRIF_END_DO_NOT_TREAT 1869 1890 ! 1870 1891 END FUNCTION iom_sdate 1871 1892 1872 1893 #else 1873 1874 1894 1875 1895 SUBROUTINE iom_setkt( kt, cdname ) -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r7646 r8817 1 1 MODULE iom_def 2 !!===================================================================== 2 !!====================================================================== 3 3 !! *** MODULE iom_def *** 4 4 !! IOM variables definitions 5 !!==================================================================== 6 !! History : 9.0 ! 06 09 (S. Masson) Original code 7 !! " ! 07 07 (D. Storkey) Add uldname 8 !!-------------------------------------------------------------------- 9 !!--------------------------------------------------------------------------------- 10 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 11 !! $Id$ 12 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 13 !!--------------------------------------------------------------------------------- 14 5 !!====================================================================== 6 !! History : 9.0 ! 2006 09 (S. Masson) Original code 7 !! - ! 2007 07 (D. Storkey) Add uldname 8 !! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 9 !!---------------------------------------------------------------------- 15 10 USE par_kind 16 11 … … 64 59 REAL(kind=wp), DIMENSION(jpmax_vars) :: scf !: scale_factor of the variables 65 60 REAL(kind=wp), DIMENSION(jpmax_vars) :: ofs !: add_offset of the variables 61 INTEGER :: nlev ! number of vertical levels 66 62 END TYPE file_descriptor 67 63 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files 68 64 !$AGRIF_END_DO_NOT_TREAT 69 65 70 !!===================================================================== 66 !!---------------------------------------------------------------------- 67 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 68 !! $Id$ 69 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 70 !!====================================================================== 71 71 END MODULE iom_def -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r7646 r8817 1 1 MODULE iom_nf90 2 !!===================================================================== 2 !!====================================================================== 3 3 !! *** MODULE iom_nf90 *** 4 4 !! Input/Output manager : Library to read input files with NF90 (only fliocom module) 5 !!==================================================================== 5 !!====================================================================== 6 6 !! History : 9.0 ! 05 12 (J. Belier) Original code 7 7 !! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO 8 8 !! " ! 07 07 (D. Storkey) Changes to iom_nf90_gettime 9 9 !! 3.6 ! 2015-15 (J. Harle) Added procedure to read REAL attributes 10 !! --------------------------------------------------------------------11 !! gm caution add !DIR nec: improved performance to be checked as well as no result changes12 13 !!-------------------------------------------------------------------- 10 !! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 11 !!---------------------------------------------------------------------- 12 13 !!---------------------------------------------------------------------- 14 14 !! iom_open : open a file read only 15 15 !! iom_close : close a file or all files opened by iom … … 18 18 !! iom_varid : get the id of a variable in a file 19 19 !! iom_rstput : write a field in a restart file (interfaced to several routines) 20 !!-------------------------------------------------------------------- 20 !!---------------------------------------------------------------------- 21 21 USE dom_oce ! ocean space and time domain 22 22 USE lbclnk ! lateal boundary condition / mpp exchanges … … 29 29 PRIVATE 30 30 31 PUBLIC iom_nf90_open , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput31 PUBLIC iom_nf90_open , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput 32 32 PUBLIC iom_nf90_getatt, iom_nf90_putatt 33 33 … … 46 46 47 47 !!---------------------------------------------------------------------- 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010)48 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 49 49 !! $Id$ 50 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 51 !!---------------------------------------------------------------------- 52 53 52 CONTAINS 54 53 55 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )54 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev ) 56 55 !!--------------------------------------------------------------------- 57 56 !! *** SUBROUTINE iom_open *** … … 64 63 LOGICAL , INTENT(in ) :: ldok ! check the existence 65 64 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 65 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the third dimension 66 66 67 67 CHARACTER(LEN=256) :: clinfo ! info character … … 76 76 INTEGER :: ihdf5 ! local variable for retrieval of value for NF90_HDF5 77 77 LOGICAL :: llclobber ! local definition of ln_clobber 78 !--------------------------------------------------------------------- 79 78 INTEGER :: ilevels ! vertical levels 79 !--------------------------------------------------------------------- 80 ! 80 81 clinfo = ' iom_nf90_open ~~~ ' 81 istop = nstop ! store the actual value of nstop 82 istop = nstop ! store the actual value of nstop 83 ! 84 ! !number of vertical levels 85 IF( PRESENT(kdlev) ) THEN ; ilevels = kdlev ! use input value (useful for sea-ice) 86 ELSE ; ilevels = jpk ! by default jpk 87 ENDIF 88 ! 82 89 IF( nn_chunksz > 0 ) THEN ; ichunk = nn_chunksz 83 90 ELSE ; ichunk = NF90_SIZEHINT_DEFAULT … … 85 92 ! 86 93 llclobber = ldwrt .AND. ln_clobber 87 IF( ldok .AND. .NOT. llclobber ) THEN ! Open existing file...88 ! ! =============94 IF( ldok .AND. .NOT. llclobber ) THEN !== Open existing file ==! 95 ! !=========================! 89 96 IF( ldwrt ) THEN ! ... in write mode 90 97 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode' … … 99 106 CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo) 100 107 ENDIF 101 ELSE ! the file does not exist(or we overwrite it)102 ! ! =============108 ELSE !== the file doesn't exist ==! (or we overwrite it) 109 ! !============================! 103 110 iln = INDEX( cdname, '.nc' ) 104 IF( ldwrt ) THEN !the file should be open in write mode so we create it...111 IF( ldwrt ) THEN !* the file should be open in write mode so we create it... 105 112 IF( jpnij > 1 ) THEN 106 113 WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' … … 126 133 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1) , idmy ), clinfo) 127 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1) , idmy ), clinfo) 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk, idmy ), clinfo)135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', ilevels , idmy ), clinfo) 129 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo) 130 137 ! global attributes … … 139 146 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end' , kdompar(:,5) ), clinfo) 140 147 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo) 141 ELSE !the file should be open for read mode so it must exist...148 ELSE !* the file should be open for read mode so it must exist... 142 149 CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 143 150 ENDIF 144 151 ENDIF 152 ! 145 153 ! start to fill file informations 146 154 ! ============= … … 156 164 iom_file(kiomid)%nvars = 0 157 165 iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode 166 iom_file(kiomid)%nlev = ilevels 158 167 CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 159 IF 160 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,&161 & name = iom_file(kiomid)%uldname,&162 &len = iom_file(kiomid)%lenuld ), clinfo )168 IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 169 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld, & 170 & name = iom_file(kiomid)%uldname, & 171 & len = iom_file(kiomid)%lenuld ), clinfo ) 163 172 ENDIF 164 173 IF(lwp) WRITE(numout,*) ' ---> '//TRIM(cdname)//' OK' … … 179 188 CHARACTER(LEN=100) :: clinfo ! info character 180 189 !--------------------------------------------------------------------- 181 !182 190 clinfo = ' iom_nf90_close , file: '//TRIM(iom_file(kiomid)%name) 183 191 CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo) 184 !185 192 END SUBROUTINE iom_nf90_close 186 193 … … 275 282 clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 276 283 CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 277 !278 284 END SUBROUTINE iom_nf90_g0d 279 285 … … 357 363 ivarid = NF90_GLOBAL 358 364 ENDIF 359 !365 ! 360 366 IF( llok) THEN 361 367 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', giatt: '//TRIM(cdatt) … … 368 374 END SUBROUTINE iom_nf90_giatt 369 375 370 SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar) 376 377 SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar ) 371 378 !!----------------------------------------------------------------------- 372 379 !! *** ROUTINE iom_nf90_gratt *** … … 376 383 !! attribute if optional variable name is supplied (cdvar)) 377 384 !!----------------------------------------------------------------------- 378 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 379 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 380 REAL(wp) , INTENT( out) :: pv_r0d ! read field 381 CHARACTER(len=*), INTENT(in ), OPTIONAL & 382 & :: cdvar ! name of the variable 383 ! 384 INTEGER :: if90id ! temporary integer 385 INTEGER :: ivarid ! NetCDF variable Id 386 LOGICAL :: llok ! temporary logical 387 CHARACTER(LEN=100) :: clinfo ! info character 385 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 386 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 387 REAL(wp) , INTENT( out) :: pv_r0d ! read field 388 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 389 ! 390 INTEGER :: if90id ! temporary integer 391 INTEGER :: ivarid ! NetCDF variable Id 392 LOGICAL :: llok ! temporary logical 393 CHARACTER(LEN=100) :: clinfo ! info character 388 394 !--------------------------------------------------------------------- 389 395 ! … … 402 408 ivarid = NF90_GLOBAL 403 409 ENDIF 404 !410 ! 405 411 IF( llok) THEN 406 412 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gratt: '//TRIM(cdatt) … … 413 419 END SUBROUTINE iom_nf90_gratt 414 420 415 SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar) 421 422 SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar ) 416 423 !!----------------------------------------------------------------------- 417 424 !! *** ROUTINE iom_nf90_gcatt *** … … 421 428 !! attribute if optional variable name is supplied (cdvar)) 422 429 !!----------------------------------------------------------------------- 423 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 424 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 425 CHARACTER(len=*), INTENT( out) :: pv_c0d ! read field 426 CHARACTER(len=*), INTENT(in ), OPTIONAL & 427 & :: cdvar ! name of the variable 428 ! 429 INTEGER :: if90id ! temporary integer 430 INTEGER :: ivarid ! NetCDF variable Id 431 LOGICAL :: llok ! temporary logical 432 CHARACTER(LEN=100) :: clinfo ! info character 430 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 431 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 432 CHARACTER(len=*) , INTENT( out) :: pv_c0d ! read field 433 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 434 ! 435 INTEGER :: if90id ! temporary integer 436 INTEGER :: ivarid ! NetCDF variable Id 437 LOGICAL :: llok ! temporary logical 438 CHARACTER(LEN=100) :: clinfo ! info character 433 439 !--------------------------------------------------------------------- 434 440 ! … … 458 464 END SUBROUTINE iom_nf90_gcatt 459 465 466 460 467 !!---------------------------------------------------------------------- 461 468 !! INTERFACE iom_nf90_putatt … … 495 502 ivarid = NF90_GLOBAL 496 503 ENDIF 497 !504 ! 498 505 IF( llok) THEN 499 506 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', piatt: '//TRIM(cdatt) … … 517 524 END SUBROUTINE iom_nf90_piatt 518 525 519 SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar) 526 527 SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar ) 520 528 !!----------------------------------------------------------------------- 521 529 !! *** ROUTINE iom_nf90_pratt *** … … 525 533 !! attribute if optional variable name is supplied (cdvar)) 526 534 !!----------------------------------------------------------------------- 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 535 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 536 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 537 REAL(wp) , INTENT(in ) :: pv_r0d ! write field 538 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 539 ! 540 INTEGER :: if90id ! temporary integer 541 INTEGER :: ivarid ! NetCDF variable Id 542 LOGICAL :: llok ! temporary logical 543 LOGICAL :: lenddef ! temporary logical 544 CHARACTER(LEN=100) :: clinfo ! info character 538 545 !--------------------------------------------------------------------- 539 546 ! … … 550 557 ivarid = NF90_GLOBAL 551 558 ENDIF 552 !559 ! 553 560 IF( llok) THEN 554 561 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pratt: '//TRIM(cdatt) … … 572 579 END SUBROUTINE iom_nf90_pratt 573 580 574 SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar) 581 582 SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar ) 575 583 !!----------------------------------------------------------------------- 576 584 !! *** ROUTINE iom_nf90_pcatt *** … … 580 588 !! attribute if optional variable name is supplied (cdvar)) 581 589 !!----------------------------------------------------------------------- 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 590 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 591 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 592 CHARACTER(len=*) , INTENT(in ) :: pv_c0d ! write field 593 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 594 ! 595 INTEGER :: if90id ! temporary integer 596 INTEGER :: ivarid ! NetCDF variable Id 597 LOGICAL :: llok ! temporary logical 598 LOGICAL :: lenddef ! temporary logical 599 CHARACTER(LEN=100) :: clinfo ! info character 593 600 !--------------------------------------------------------------------- 594 601 ! … … 605 612 ivarid = NF90_GLOBAL 606 613 ENDIF 607 !614 ! 608 615 IF( llok) THEN 609 616 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pcatt: '//TRIM(cdatt) … … 658 665 659 666 SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid , ktype, & 660 & pv_r0d, pv_r1d, pv_r2d, pv_r3d )667 & pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 661 668 !!-------------------------------------------------------------------- 662 669 !! *** SUBROUTINE iom_nf90_rstput *** … … 687 694 INTEGER :: itype ! variable type 688 695 INTEGER, DIMENSION(4) :: ichunksz ! NetCDF4 chunk sizes. Will be computed using 689 ! nn_nchunks_[i,j,k,t] namelist parameters 690 INTEGER :: ichunkalg, ishuffle,& 691 ideflate, ideflate_level 692 ! NetCDF4 internally fixed parameters 696 ! ! nn_nchunks_[i,j,k,t] namelist parameters 697 INTEGER :: ichunkalg, ishuffle, ideflate, ideflate_level 698 ! ! NetCDF4 internally fixed parameters 693 699 LOGICAL :: lchunk ! logical switch to activate chunking and compression 694 ! when appropriate (currently chunking is applied to 4d fields only) 700 ! ! when appropriate (currently chunking is applied to 4d fields only) 701 INTEGER :: idlv ! local variable 695 702 !--------------------------------------------------------------------- 696 703 ! … … 706 713 ENDIF 707 714 ! define the dimension variables if it is not already done 708 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter' /) 715 IF(iom_file(kiomid)%nlev == jpk ) THEN 716 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter' /) 717 ELSE 718 cltmp = (/ 'nav_lon ', 'nav_lat ', 'numcat ', 'time_counter' /) 719 ENDIF 709 720 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 710 721 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) … … 755 766 IF( PRESENT(pv_r0d) ) THEN 756 767 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, & 757 & iom_file(kiomid)%nvid(idvar) ), clinfo)768 & iom_file(kiomid)%nvid(idvar) ), clinfo ) 758 769 ELSE 759 770 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims), & 760 & iom_file(kiomid)%nvid(idvar) ), clinfo)771 & iom_file(kiomid)%nvid(idvar) ), clinfo ) 761 772 ENDIF 762 773 lchunk = .false. 763 IF( snc4set%luse .AND. idims .eq.4 )lchunk = .true.774 IF( snc4set%luse .AND. idims == 4 ) lchunk = .true. 764 775 ! update informations structure related the new variable we want to add... 765 776 iom_file(kiomid)%nvars = idvar … … 782 793 ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6 783 794 ichunksz(4) = 1 ! Do not allow chunks to span the 784 795 ! ! unlimited dimension 785 796 CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo) 786 797 CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo) … … 791 802 idvar = kvid 792 803 ENDIF 793 804 ! 794 805 ! time step kwrite : write the variable 795 806 IF( kt == kwrite ) THEN … … 815 826 ! trick: is defined to 0 => dimension variable are defined but not yet written 816 827 IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 817 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon' , idmy ), clinfo) 818 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo) 819 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat' , idmy ), clinfo) 820 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo) 821 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo) 822 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d ), clinfo) 828 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon' , idmy ) , clinfo ) 829 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 830 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat' , idmy ) , clinfo ) 831 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 832 IF(iom_file(kiomid)%nlev == jpk ) THEN 833 !NEMO 834 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo ) 835 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gdept_1d ), clinfo ) 836 ELSE 837 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'numcat' , idmy ), clinfo) 838 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 839 ENDIF 823 840 ! +++ WRONG VALUE: to be improved but not really useful... 824 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)825 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt ), clinfo)841 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 842 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt ), clinfo ) 826 843 ! update the values of the variables dimensions size 827 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)828 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)844 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 845 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 829 846 iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 830 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)847 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 831 848 iom_file(kiomid)%dimsz(1 , 4) = 1 ! unlimited dimension 832 849 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' … … 837 854 ! ============= 838 855 IF( PRESENT(pv_r0d) ) THEN 839 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r0d ), clinfo)856 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r0d ), clinfo ) 840 857 ELSEIF( PRESENT(pv_r1d) ) THEN 841 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r1d( :) ), clinfo)858 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r1d(:) ), clinfo ) 842 859 ELSEIF( PRESENT(pv_r2d) ) THEN 843 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2 ) ), clinfo)860 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2,iy1:iy2) ), clinfo ) 844 861 ELSEIF( PRESENT(pv_r3d) ) THEN 845 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)862 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2,iy1:iy2,:) ), clinfo ) 846 863 ENDIF 847 864 ! add 1 to the size of the temporal dimension (not really useful...)
Note: See TracChangeset
for help on using the changeset viewer.
