Changeset 239 for trunk/NEMO/OPA_SRC/DOM/domhgr.F90
- Timestamp:
- 2005-03-22T18:55:20+01:00 (19 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DOM/domhgr.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/domhgr.F90
r236 r239 8 8 !! dom_hgr : initialize the horizontal mesh 9 9 !! hgr_read : read "coordinate" NetCDF file 10 !! hgr_read_fdir : read "coordinate" direct access file11 10 !!---------------------------------------------------------------------- 12 11 !! * Modules used … … 130 129 IF(lwp) WRITE(numout,*) 131 130 IF(lwp) WRITE(numout,*) ' curvilinear coordinate on the sphere read in "coordinate" file' 132 #if defined key_fdir 133 CALL hgr_read_fdir ! 'key_fdir' : direct access file 134 #else 131 135 132 CALL hgr_read ! Defaultl option : NetCDF file 136 #endif137 133 138 134 ! ! ===================== … … 644 640 END SUBROUTINE hgr_read 645 641 646 647 SUBROUTINE hgr_read_fdir648 !!----------------------------------------------------------------------649 !! *** ROUTINE hgr_read_fdir ***650 !!651 !!----------------------------------------------------------------------652 !! * Local declarations653 CHARACTER (len=5) :: clfield654 CHARACTER(len=21) :: clname = 'coordinates'655 INTEGER :: ji, jj ! dummy loop indices656 INTEGER :: inumcoo = 11 ! logical unit for coordinate file657 INTEGER :: ijpi, ijpj ! temporary integers658 REAL(wp), DIMENSION(jpi,jpj) :: zdta ! temporary workspace659 !!----------------------------------------------------------------------660 661 662 ! 1. Read of the grid coordinates and scale factors663 ! -------------------------------------------------664 665 IF(lwp) THEN666 WRITE(numout,*)667 WRITE(numout,*) 'hgrcoo : read the horizontal coordinates'668 WRITE(numout,*) '~~~~~~'669 WRITE(numout,*) ' jpiglo jpjglo jpk : ', jpiglo, jpjglo, jpk670 ENDIF671 672 ! open the file673 CALL ctlopn( inumcoo, clname, 'OLD', 'UNFORMATTED', 'SEQUENTIAL', &674 1 , numout , lwp , 1 )675 676 ! read the file677 READ(inumcoo) ijpi,ijpj678 IF( (ijpi /= jpidta) .OR. (ijpj /= jpjdta) ) THEN679 IF(lwp) THEN680 WRITE(numout,*)681 WRITE(numout,*) ' inconsitency in reading coordinate file, unit=',inumcoo682 WRITE(numout,*) ' jpidta = ',jpidta ,' jpi read = ',ijpi683 WRITE(numout,*) ' jpjdta = ',jpjdta ,' jpj read = ',ijpj684 WRITE(numout,*)685 ENDIF686 nstop = nstop + 1687 ENDIF688 689 READ(inumcoo) clfield, zdta690 IF( clfield /= 'GLAMT' ) THEN691 IF(lwp) THEN692 WRITE(numout,cform_err)693 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMT'694 ENDIF695 nstop = nstop + 1696 ENDIF697 DO jj = 1, nlcj698 DO ji = 1, nlci699 glamt(ji,jj) = zdta(mig(ji),mjg(jj))700 END DO701 END DO702 READ(inumcoo) clfield, zdta703 IF(clfield /= 'GLAMU') THEN704 IF(lwp) THEN705 WRITE(numout,cform_err)706 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMU'707 ENDIF708 nstop = nstop + 1709 ENDIF710 DO jj = 1, nlcj711 DO ji = 1, nlci712 glamu(ji,jj) = zdta(mig(ji),mjg(jj))713 END DO714 END DO715 READ(inumcoo) clfield, zdta716 IF(clfield /= 'GLAMV') THEN717 IF(lwp) THEN718 WRITE(numout,cform_err)719 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMV'720 ENDIF721 nstop = nstop + 1722 ENDIF723 DO jj = 1, nlcj724 DO ji = 1, nlci725 glamv(ji,jj) = zdta(mig(ji),mjg(jj))726 END DO727 END DO728 READ(inumcoo) clfield, zdta729 IF(clfield /= 'GLAMF') THEN730 IF(lwp) THEN731 WRITE(numout,cform_err)732 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMF'733 ENDIF734 nstop = nstop + 1735 ENDIF736 DO jj = 1, nlcj737 DO ji = 1, nlci738 glamf(ji,jj) = zdta(mig(ji),mjg(jj))739 END DO740 END DO741 READ(inumcoo) clfield, zdta742 IF(clfield /= 'GPHIT') THEN743 IF(lwp) THEN744 WRITE(numout,cform_err)745 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIT'746 ENDIF747 nstop = nstop + 1748 ENDIF749 DO jj = 1, nlcj750 DO ji = 1, nlci751 gphit(ji,jj) = zdta(mig(ji),mjg(jj))752 END DO753 END DO754 READ(inumcoo) clfield, zdta755 IF(clfield /= 'GPHIU') THEN756 IF(lwp) THEN757 WRITE(numout,cform_err)758 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIU'759 ENDIF760 nstop = nstop + 1761 ENDIF762 DO jj = 1, nlcj763 DO ji = 1, nlci764 gphiu(ji,jj) = zdta(mig(ji),mjg(jj))765 END DO766 END DO767 READ(inumcoo) clfield, zdta768 IF(clfield /= 'GPHIV') THEN769 IF(lwp) THEN770 WRITE(numout,cform_err)771 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIV'772 ENDIF773 nstop = nstop + 1774 ENDIF775 DO jj = 1, nlcj776 DO ji = 1, nlci777 gphiv(ji,jj) = zdta(mig(ji),mjg(jj))778 END DO779 END DO780 READ(inumcoo) clfield, zdta781 IF(clfield /= 'GPHIF') THEN782 IF(lwp) THEN783 WRITE(numout,cform_err)784 WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIF'785 ENDIF786 nstop = nstop + 1787 ENDIF788 DO jj = 1, nlcj789 DO ji = 1, nlci790 gphif(ji,jj) = zdta(mig(ji),mjg(jj))791 END DO792 END DO793 READ(inumcoo) clfield, zdta794 IF(clfield /= 'E1T ') THEN795 IF(lwp) THEN796 WRITE(numout,cform_err)797 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1T '798 ENDIF799 nstop = nstop + 1800 ENDIF801 DO jj = 1, nlcj802 DO ji = 1, nlci803 e1t (ji,jj) = zdta(mig(ji),mjg(jj))804 END DO805 END DO806 READ(inumcoo) clfield, zdta807 IF(clfield /= 'E1U ') THEN808 IF(lwp) THEN809 WRITE(numout,cform_err)810 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1U '811 ENDIF812 nstop = nstop + 1813 ENDIF814 DO jj = 1, nlcj815 DO ji = 1, nlci816 e1u (ji,jj) = zdta(mig(ji),mjg(jj))817 END DO818 END DO819 READ(inumcoo) clfield, zdta820 IF(clfield /= 'E1V ') THEN821 IF(lwp) THEN822 WRITE(numout,cform_err)823 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1V '824 ENDIF825 nstop = nstop + 1826 ENDIF827 DO jj = 1, nlcj828 DO ji = 1, nlci829 e1v (ji,jj) = zdta(mig(ji),mjg(jj))830 END DO831 END DO832 READ(inumcoo) clfield, zdta833 IF(clfield /= 'E1F ') THEN834 IF(lwp) THEN835 WRITE(numout,cform_err)836 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1F '837 ENDIF838 nstop = nstop + 1839 ENDIF840 DO jj = 1, nlcj841 DO ji = 1, nlci842 e1f (ji,jj) = zdta(mig(ji),mjg(jj))843 END DO844 END DO845 READ(inumcoo) clfield, zdta846 IF(clfield /= 'E2T ') THEN847 IF(lwp) THEN848 WRITE(numout,cform_err)849 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2T '850 ENDIF851 nstop = nstop + 1852 ENDIF853 DO jj = 1, nlcj854 DO ji = 1, nlci855 e2t (ji,jj) = zdta(mig(ji),mjg(jj))856 END DO857 END DO858 READ(inumcoo) clfield, zdta859 IF(clfield /= 'E2U ') THEN860 IF(lwp) THEN861 WRITE(numout,cform_err)862 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2U '863 ENDIF864 nstop = nstop + 1865 ENDIF866 DO jj = 1, nlcj867 DO ji = 1, nlci868 e2u (ji,jj) = zdta(mig(ji),mjg(jj))869 END DO870 END DO871 READ(inumcoo) clfield, zdta872 IF(clfield /= 'E2V ') THEN873 IF(lwp) THEN874 WRITE(numout,cform_err)875 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2V '876 ENDIF877 nstop = nstop + 1878 ENDIF879 DO jj = 1, nlcj880 DO ji = 1, nlci881 e2v (ji,jj) = zdta(mig(ji),mjg(jj))882 END DO883 END DO884 READ(inumcoo) clfield, zdta885 IF(clfield /= 'E2F ') THEN886 IF(lwp) THEN887 WRITE(numout,cform_err)888 WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2F '889 ENDIF890 nstop = nstop + 1891 ENDIF892 DO jj = 1, nlcj893 DO ji = 1, nlci894 e2f (ji,jj) = zdta(mig(ji),mjg(jj))895 END DO896 END DO897 898 CLOSE( inumcoo )899 900 ! set extra rows add in mpp to none zero values901 DO jj = nlcj+1, jpj902 DO ji = 1, nlci903 glamt(ji,jj) = glamt(ji,1) ; gphit(ji,jj) = gphit(ji,1)904 glamu(ji,jj) = glamu(ji,1) ; gphiu(ji,jj) = gphiu(ji,1)905 glamv(ji,jj) = glamv(ji,1) ; gphiv(ji,jj) = gphiv(ji,1)906 glamf(ji,jj) = glamf(ji,1) ; gphif(ji,jj) = gphif(ji,1)907 e1t (ji,jj) = e1t (ji,1) ; e2t (ji,jj) = e2t (ji,1)908 e1u (ji,jj) = e1u (ji,1) ; e2u (ji,jj) = e2u (ji,1)909 e1v (ji,jj) = e1v (ji,1) ; e2v (ji,jj) = e2v (ji,1)910 e1f (ji,jj) = e1f (ji,1) ; e2f (ji,jj) = e2f (ji,1)911 END DO912 END DO913 914 ! set extra columns add in mpp to none zero values915 DO ji = nlci+1, jpi916 glamt(ji,:) = glamt(1,:) ; gphit(ji,:) = gphit(1,:)917 glamu(ji,:) = glamu(1,:) ; gphiu(ji,:) = gphiu(1,:)918 glamv(ji,:) = glamv(1,:) ; gphiv(ji,:) = gphiv(1,:)919 glamf(ji,:) = glamf(1,:) ; gphif(ji,:) = gphif(1,:)920 e1t (ji,:) = e1t (1,:) ; e2t (ji,:) = e2t (1,:)921 e1u (ji,:) = e1u (1,:) ; e2u (ji,:) = e2u (1,:)922 e1v (ji,:) = e1v (1,:) ; e2v (ji,:) = e2v (1,:)923 e1f (ji,:) = e1f (1,:) ; e2f (ji,:) = e2f (1,:)924 END DO925 926 END SUBROUTINE hgr_read_fdir927 928 642 !!====================================================================== 929 643 END MODULE domhgr
Note: See TracChangeset
for help on using the changeset viewer.
